home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE TextWindows;⓪ (*$Y+*)⓪ ⓪ (*⓪ IMPORT Terminal; (* for debuging only *)⓪ *)⓪ ⓪ ⓪ (* Implementation des 'TextWindows' Modul der Megamax Modula-2 Library⓪!*⓪!* Written and copyright by Manuel Chakravarty⓪!*⓪!* Version 2.10 V#0891 Created 24.09.1987⓪!*)⓪!⓪!⓪ (* 24.09.87 | Definitionen; 'levelCounter', 'Close' und 'Open' impl.⓪!* 25.09.87 | 'writeSpaceBlock' mit drumherum impl. +⓪!* 'WriteString' ohne VT-52, dabei auch 'writeStringPart'⓪!* 27.09.87 | 'WriteString' optimiert⓪!* 28.09.87 | 'WriteString' optimiert (jetzt Terminal:Windows ~ 1:4)⓪!* scrolling + 'Write' impl.⓪!* 29.09.87 | 'Read' impl. + 'ReadString' vorl. Vers. + Redraw⓪!* 30.09.87 | Verarbeitung der window events⓪!* 01.10.87 | Modul verwendet Sys... und berücksichtigt fremde⓪!* 'GemHandle's richtig.⓪!* 02.10.87 | V 0.2: Umdef. von Open-Param.; besserer Redraw⓪!* 06.10.87 | Neues 'windowText' ; Anpassung an GEM V 0.9⓪!* + VT-52 Emulator (Teile)⓪!* 07.10.87 | 'SelectChar' impl.⓪!* 08.10.87 | VT-52 fertiggestellt + 'IsTop' + 'CursorPos'⓪!* 09.10.87 | Scrolling im Hintergrund funkt. endlich + 'WasClosed'⓪!* 13.10.87 | 'ReSpecify' impl.⓪!* 14.10.87 | Enhanced output + 'getCharSize' über VDI⓪!* 07.11.87 | Anpassung an GEM V 0.10 + 'WindowHandle' -> 'Window' +⓪!* 'SelectChar' gibt Zeichenbox mit zurück⓪!* ??.11.87 | Anpassung an endgültige Definitionen⓪!* 'SelectChar' -> 'FindChar', usw.⓪!* 02.12.87 | Redrawgeschwindigkeit erhöht⓪!* 03.12.87 | 'Open' auf endgültige Def gebracht und 'EditString' von⓪!* 'Terminal' geklaut⓪!* 07.12.87 | 'ReSpecify' fordert neuen Speicher nur an, falls sich⓪!* die Bufferausmaße geändert haben. Enhanced-Status abge-⓪!* sichert, dazu 'enhcdWind' eingeführt.⓪!* 08.12.87 | Check auf Zeilenende wird immer vor der Ausgabe sicht-⓪!* barer Zeichen durchgeführt.⓪!* 22.12.87 | 'DetectChar' läßt jetzt auch 'NoWind' als Element im⓪!* open array zu (Ermöglicht Fenstercheck ohne das beim⓪!* Aufrufer irgendwelche 'Window'-Handle bekannt sind)⓪!* 27.12.87 | 'takeCareOfForce' auch am Anfang einer Stringausgabe⓪!* 12.01.88 | 'copyOpaque' impl.⓪!* 13.01.88 | CTRL-E/F für 'EnhancedOutput (TRUE/FALSE)'⓪!* | Neues 'adjust'⓪!* 17.01.88 | Falls Fensterausmaße bei 'Open' zu klein sind werden⓪!* sie auf Min.maße vergößert.⓪!* 21.01.88 | 'WasClosed' bereinigt A3 und 'copyOpaque's hoffentlich⓪!* letzten Fehler beseitigt.⓪!* 24.01.88 | 'nextChar' in ASM und 'forceLine' eingeführt⓪!* 26.01.88 | 'copyOpaque' macht vdiCopy bei Farbe.⓪!* 31.01.88 | Während der Behandlung eines Events (watch dog) darf⓪!* kein 'ShareTime' gemacht werden => siehe 'eventHandling'⓪!* 05.04.88 | 'KeyPressed' arbeitet jetzt mit globalem Tastenbuffer für⓪!* ein Zeichen.⓪!* 'ReadString' schaltet Cursor nicht ein, falls⓪!* noch Zeichen im Tastaturpuffer vorliegen.⓪!* Bei 'interpretCtrl' werden auch die nicht interpretierbaren⓪!* Ctrl-Zeichen nicht angezeigt.⓪!* 06.04.88 | Beim Schreiben in unsichtbare Fenster wird nun auch im⓪!* enhanced mode der Mauscursor nicht mehr versteckt.⓪!* Lokales Modul 'Timer'.⓪!* 07.04.88 | VT-52-Emulation für ESC-L und ESC-M impl.⓪!*⓪!* 02.02.89 MCH 0.04 | Beginn der Umstellung auf 'WindowBase' und der⓪!* Trennung der Bufferschreibenden und -lesenden⓪!* Vorgänge.⓪!* 15.02.89 MCH 0.04 | Pipes + 'insertIntoWritePipe'.⓪!* 16.02.89 MCH 0.04 | write proc.s newly + 'escAutomat' impl.⓪!* 21.02.89 MCH 0.04 | 'flushWritePipe' impl.⓪!* 22.02.89 MCH 0.04 | 'doWaitingRedraws' + server proc.s impl.⓪!* 23.02.89 MCH 0.04 | server proc.s weiter⓪!* 26.02.89 MCH 0.04 | Debugging.⓪!* 27.02.89 MCH 0.04 | No internal esc sequences.⓪!* 28.02.89 MCH 0.04 | While redrawing, background is cleared first.⓪!* 'insertIntoWritePipe' copys until a 0C is matched.⓪!* 'SetPosAndSize', 'SetTop' and 'ReadTextBuffer' impl.⓪!* 01.03.89 MCH 2.00 | The 'escAutomat' sets the 'status.state' to the⓪!* right value, at the end of 'gotoXY', 'fgCol' and⓪!* 'bgCol'.⓪!* THE NEW VERSION IS COMPLETELY IMPLEMENTED.⓪!* 04.06.89 MCH 2.01 | 'takeCareOfForce' is not applied at hidden wdw.s⓪!* 27.06.89 MCH 2.02 | Uses 'ResCtrl'⓪!* 30.07.89 MCH 2.03 | 'doWaitingRedraws' inserted into 'scrollUp/Down',⓪!* Not Tested!⓪!* 31.07.89 MCH 2.03 | While enhanced mode on, no redraw before scrolling;⓪!* movement of redraw area, while scrolling.⓪!* 01.08.89 MCH 2.04 | 'takeCareOfForce' uses 'SetWindowSliderPos'⓪!* 02.08.89 MCH 2.04 | Uses 'SysCreateWindow' and 'FlushEvents';⓪!* 'SetTop' -> 'PutOnTop'⓪!* 11.08.89 MCH 2.05 | Uses 'reverseWrt'; 'maxCharPerRow' raus; ⓪!* 'pointToCharPos' arbeitet jetzt auch richtig, wenn⓪!* das 'WindowBase'-Fenster größer als der Puffer ist.⓪!* 15.08.89 MCH 2.06 | Uses 'WindowBase' V0.12 ⓪!* 16.08.89 MCH 2.06 | Some changes in 'checkSpec'⓪!* 17.08.89 MCH 2.06 | 'pipeEscStatus' eingeführt⓪!* 19.08.89 MCH 2.07 | 'GetGSX' und 'GetKey' def. + impl.⓪!* 30.08.89 TT 2.08 | ReadLine, EditLine, ReadToken, UndoRead;⓪!* keyBuffer-Verwaltung geändert (neue BOOLEAN-Var);⓪!* Done-Funktion neu (ebenso done-feld in Window-Record)⓪!* 15.02.90 MCH 2.9 | Anpassung an Compilerversion 4.0 (REFs)⓪!* 06.04.90 MCH 2.9 | 'DetectChar' liefert jetzt hoffentlich korrekte 'box'⓪!* 25.11.90 TT | GrafMouse-Aufruf nun in connectToGem statt in⓪!* levelCounter, weil sont ModLoad nicht funktioniert⓪!* 17.12.90 TT | FastGEM0-Import erstmal entfernt, da immer noch⓪!* Fehler bei Bigscreen⓪!* 15.02.91 TT | 'scrollDown' (reverse LF) benutzt copyVertWdw statt⓪!* copyHorWdw; 'insert/deleteLine' funktionieren auch in⓪!* 1. Zeile (Abfrage auf f.y>0 durch f.y>=0 ersetzt);⓪!* Cursor ist wieder sichtbar (cursorOn: / gg. + ers.).⓪!* 02.03.91 TT | Close mit undef. Ptr meldet keinen Laufzeitfehler⓪!* 08.04.91 TT | Open: Wenn alle Fenster belegt, liefert success FALSE⓪!* 15.09.91 MS | Open: Speicher f. redrawStr wird bei Fehlern wieder⓪!* freigegeben.⓪!* 21.05.93 TT | Mittels Respecify kann nun auch der Font bestimmt⓪!* werden; SetPosAndSize rundet nicht mehr ab.⓪!* 07.06.93 TT | Auch wenn kein Force-Modus, wird bei Eingaben (Read)⓪!* das Fenster getopped und Cursor sichtbar gescrollt.⓪!* 14.01.94 TT | checkSpec korrigiert.⓪!*)⓪ ⓪ (* =============== to do: ====================⓪!*⓪!* =============== docu: =====================⓪!*⓪!*)⓪!⓪!⓪ FROM SYSTEM IMPORT ASSEMBLER, WORD, ADDRESS, BYTE,⓪7TSIZE, ADR;⓪ ⓪ (* MOS *)⓪ ⓪ IMPORT StringEditor, MOSConfig;⓪ ⓪ FROM Calls IMPORT CallSupervisor;⓪ ⓪ FROM Storage IMPORT SysAlloc, DEALLOCATE;⓪ ⓪ FROM MOSGlobals IMPORT IllegalPointer, GeneralErr, MemArea, Key;⓪ ⓪ FROM PrgCtrl IMPORT EnvlpCarrier, TermCarrier,⓪7SetEnvelope, CatchProcessTerm;⓪ ⓪ FROM ResCtrl IMPORT RemovalCarrier,⓪7CatchRemoval;⓪ ⓪ FROM Strings IMPORT Assign, Length, StrEqual, Delete;⓪ ⓪ (* GEM *)⓪ ⓪ FROM GrafBase IMPORT Point, Rectangle, MemFormDef, white, black,⓪?BitOperation, LongPnt, LongRect,⓪?Pnt, Rect, TransRect, ClipRect, GetBlitterMode,⓪?GetScreen, MinPoint, MaxPoint, FrameRects,⓪?WritingMode, LPnt, LRect;⓪5⓪ FROM GEMGlobals IMPORT TextEffect, TEffectSet, GemChar, MButtonSet,⓪?THorJust, TVertJust,⓪?SpecialKeySet, MouseButton, FillType;⓪ ⓪ FROM GEMEnv IMPORT RC, GemHandle, DeviceHandle, GDOSAvailable,⓪?SysInitGem, ExitGem, CurrGemHandle, PtrDevParm,⓪?DeviceParameter, SetCurrGemHandle, GemActive;⓪ ⓪ FROM AESEvents IMPORT Event, RectEnterMode;⓪ ⓪ FROM AESGraphics IMPORT MouseForm, GrafMouse;⓪ ⓪ FROM VDIControls IMPORT LoadFonts, SetClipping, DisableClipping;⓪ ⓪ FROM VDIAttributes IMPORT SetTextColor, SetTextEffects, SetFillColor,⓪?SetFillType, SetFillPerimeter, SetWritingMode,⓪?SetPtsTHeight, SetAbsTHeight, SetTextFace;⓪ ⓪ FROM VDIOutputs IMPORT FillRectangle, GrafText;⓪ ⓪ FROM VDIInputs IMPORT HideCursor, ShowCursor;⓪ ⓪ FROM VDIInquires IMPORT GetTextStyle, GetFaceName, GetFaceInfo;⓪ ⓪ IMPORT AESWindows, GEMBase;⓪ ⓪ (* Beyond GEM *)⓪ ⓪ FROM EventHandler IMPORT EventProc, WatchDogCarrier,⓪?SysInstallWatchDog, DeInstallWatchDog,⓪?HandleEvents, FlushEvents;⓪ ⓪ IMPORT WindowBase;⓪ ⓪ FROM VDIRasters IMPORT CopyOpaque;⓪ ⓪ CONST TestVersion = FALSE; (* Debugging? *)⓪ ⓪ (*$? NOT TestVersion: (*$R-*)⓪!*)⓪ ⓪ ⓪ CONST windowMagic = 170469; (* Woher kommt diese Zahl ??!? *)⓪(⓪(bufMax = MaxCard;⓪(maxNameLen = 80;⓪(⓪(pipeMax = 512; (* Number of elem.s per pipe *)⓪(⓪(fractionBaseL = 10000L;⓪/⓪(noErrorTrap = 6;⓪(⓪((* char const.s *)⓪(⓪(null = 0C;⓪(ctrlE = 5C;⓪(ctrlF = 6C;⓪(bell = 7C;⓪(bs = 10C;⓪(lf = 12C;⓪(cr = 15C;⓪(ctrlP = 20C;⓪(esc = 33C;⓪(space = 40C;⓪ ⓪ ⓪ TYPE twoChars = ARRAY[0..1] OF CHAR;⓪(fourChars = ARRAY[0..3] OF CHAR;⓪ ⓪((* pipes⓪)*)⓪(pipe = POINTER TO pipeDesc;⓪(pipeDesc = RECORD⓪<data : ARRAY[1..pipeMax] OF CHAR;⓪<head, (* write here *)⓪<tail : CARDINAL; (* read here *)⓪:END;⓪(⓪((* esc automat⓪)*)⓪(escState = (normalEsc, escEsc, gotoXEsc, gotoYEsc, fgEsc, bgEsc);⓪(escStatusDesc = RECORD⓪<state : escState;⓪<first : CHAR;⓪:END;⓪(escComand = (normalCharEsc, nothingEsc, cursUpEsc, cursDownEsc,⓪;cursLeftEsc, cursRightEsc, clsEsc, homeEsc,⓪;eraseEOPEsc, reverseLfEsc, clrEOLEsc, insLnEsc,⓪;delLnEsc, gotoXYEsc, fgColEsc, bgColEsc,⓪;eraseBegDispEsc, cursOnEsc, cursOffEsc,⓪;saveCursPosEsc, restoreCursPosEsc, eraseLnEsc,⓪;eraseBegLnEsc, reverseOnEsc, reverseOffEsc,⓪;wrapOnEsc, wrapOffEsc, flushEsc, enhanceOffEsc,⓪;enhanceOnEsc);⓪(escResultDesc = RECORD⓪(⓪<comand : escComand;⓪<⓪<(* valid, if 'comand = normalCharEsc'.⓪=*)⓪<ch : CHAR;⓪<⓪<(* valid, if 'comand = gotoXYEsc'.⓪=*)⓪<x, y,⓪<⓪<(* valid, if 'comand = fgColEsc'.⓪=*)⓪<fgCol,⓪<⓪<(* valid, if 'comand = bgColEsc'.⓪=*)⓪<bgCol : CARDINAL;⓪<⓪:END;⓪(⓪((* types for the text buffer.⓪)*)⓪(effect = (inverse);⓪(effectSet = SET OF effect;⓪(bufferElem = RECORD (* TSIZE (bufferElem) = 2 !!!!! *)⓪<effects : effectSet;⓪<ch : CHAR;⓪:END;⓪(ptrBufferElem = POINTER TO bufferElem;⓪(bufRange = [0..bufMax];⓪ ⓪((* window descriptor.⓪)*)⓪(ptrWindow = POINTER TO window;⓪(window = RECORD⓪<handle : WindowBase.Window; (* AES handle *)⓪<columns, rows: CARDINAL; (* Textausmaße *)⓪<force : ForceMode;⓪<quality : WQualitySet;⓪<⓪<ctrlMode : CtrlMode; (* Ctrl-Zeichen drucken?*)⓪<echoMode : EchoMode; (* Echo bei Read's? *)⓪<wrapAround : BOOLEAN; (* Verhalten am Zeilenende*)⓪<⓪<bgCol, fgCol : CARDINAL; (* Hinter-/Vordergrund *)⓪<fontHdl : CARDINAL;⓪<fontSize : CARDINAL; (* Größe in Pts *)⓪<charW, charH : INTEGER; (* Breite und Höhe einer Zeichenzelle *)⓪<topToBase : INTEGER; (* Abstand von top- zu baseline *)⓪<minADE, maxADE: CHAR; (* Kleinstes und größtes Zeichen des Fonts *)⓪<⓪<noCursHides : CARDINAL; (* number of curs. hides*)⓪<cursX, cursY : CARDINAL; (* Cursorposition *)⓪<cursIndex : bufRange; (* Curs.pos. als Index *)⓪<⓪<revMode : BOOLEAN; (* Reverse mode? *)⓪<⓪<closed : BOOLEAN;⓪<⓪<pipeEscStatus,⓪<escStatus : escStatusDesc; (* VT52 *)⓪<cursXSave,⓪<cursYSave : CARDINAL;⓪<⓪<done : BOOLEAN; (* f. Done-Funktion *)⓪<⓪<enhanced : BOOLEAN; (* enhanced-mode? *)⓪<⓪<writePipe : pipe; (* buffers the in-stream*)⓪<redrawArea : Rectangle; (* '.w = 0' means none *)⓪<⓪<textOrg : bufRange; (* Zeichen links oben *)⓪<buffer : POINTER TO (* Textbuffer *)⓪MARRAY bufRange OF bufferElem;⓪<⓪<redrawStr : POINTER TO ARRAY[0..32767] OF CHAR;⓪<⓪<magic : LONGCARD;⓪<level : INTEGER; (* modLevel bei Anmeldung *)⓪<next : ptrWindow; (* Listenzeiger *)⓪:END;⓪(Window = ptrWindow;⓪(⓪ CONST noWindPtr = ptrWindow (NoWind);⓪(⓪ ⓪ VAR windowRoot : ptrWindow;⓪(eventHandling : BOOLEAN; (* '= TRUE' ~ Event-Behandlung *)⓪(gemHdl : GemHandle;⓪(device : DeviceHandle;⓪(stdMFDB : MemFormDef;⓪(Fonts : CARDINAL;⓪(StdFontHdl : CARDINAL;⓪(StdFontHeight : CARDINAL;⓪(stdCharW, stdCharH: CARDINAL;⓪(⓪(voidO : BOOLEAN; (* BOOLEAN-Var. zum Param. füllen *)⓪(voidI : INTEGER;⓪(voidC : CARDINAL;⓪(⓪(modLevel : INTEGER; (* 0 ~ SysLevel; -1 nach 'removalProc' *)⓪(⓪(globToken : BOOLEAN;⓪(globHdl : Window;⓪ ⓪ ⓪(⓪ MODULE Timer; (* Lokales Modul, das eine Proc. regelmäßig aufruft *)⓪ ⓪ ⓪ IMPORT ASSEMBLER, ADDRESS, MemArea,⓪'ADR, CallSupervisor;⓪ ⓪ EXPORT installTimeProc, careOfTime;⓪ ⓪ ⓪ VAR timeProc : PROC;⓪(timeGap : CARDINAL;⓪(passedTime : LONGCARD;⓪(⓪(⓪ PROCEDURE installTimeProc (proc:PROC; gap:CARDINAL);⓪ ⓪"BEGIN⓪$timeProc:=proc; timeGap:=gap; passedTime:=0L;⓪"END installTimeProc;⓪"⓪ VAR readTimeLast : LONGCARD;⓪ ⓪ PROCEDURE readTime (adr:ADDRESS);⓪ ⓪"VAR _hz_200 [$4BA] : LONGCARD;⓪*_timer_ms [$442]: CARDINAL;⓪"⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #4,A3⓪(⓪(MOVE.L _hz_200,D0⓪(SUB.L readTimeLast,D0⓪(MULU _timer_ms,D0⓪(ADD.L passedTime,D0⓪(MOVE.L D0,passedTime⓪"END;⓪"END readTime;⓪"(*$L=*)⓪ ⓪ PROCEDURE careOfTime;⓪ ⓪"VAR stack : ARRAY[0..511] OF CARDINAL;⓪*wsp : MemArea;⓪"⓪"BEGIN⓪$IF timeGap > 0 THEN⓪&wsp.bottom:=ADR (stack); wsp.length:=SIZE (stack);⓪&CallSupervisor (readTime, NIL, wsp);⓪&IF passedTime >= LONG (timeGap) THEN passedTime:=0L; timeProc END;⓪$END;⓪"END careOfTime;⓪ ⓪ ⓪ BEGIN⓪"timeGap:=0;⓪"readTimeLast:=0L;⓪ END Timer; (* -- Ende des lokalen Moduls -- *)⓪ ⓪ ⓪8(* graphic proc.s *)⓪8(* ============== *)⓪ ⓪ (* grafText -- Gibt String mit Effekten aus.⓪!* REF wegen Effizenz (und wegen Übergabe von 'MaxCard + 1'⓪!* Elementen).⓪!*)⓪ ⓪ PROCEDURE grafText ( device : DeviceHandle;⓪8p : Point;⓪4REF str : ARRAY OF CHAR;⓪8effects: effectSet);⓪ ⓪"BEGIN⓪$IF inverse IN effects THEN SetWritingMode (device, reverseWrt) END;⓪$⓪$(* GrafText (device, p, str);⓪%*⓪%* Damit nicht 'MaxCard + 1' als Stringlänge übergeben wird, muß dies in⓪%* Assembler geschrieben werden.⓪%*)⓪$ASSEMBLER⓪$⓪(; Berechne: D0 := Length (str)⓪(;⓪(MOVE.W #1, D0⓪(MOVE.L str(A6), A0⓪ loop1⓪(ADDQ.W #1, D0⓪(TST.B (A0)+⓪(BNE loop1⓪(ANDI.W #-2, D0 ; gerade Anzahl!⓪(⓪(; call 'GrafText'⓪(;⓪(MOVE.L device(A6), (A3)+⓪(MOVE.L p(A6), (A3)+⓪(MOVE.L str(A6), (A3)+⓪(MOVE.W D0, (A3)+⓪(JSR GrafText⓪$END;⓪%⓪$IF inverse IN effects THEN SetWritingMode (device, replaceWrt) END;⓪"END grafText;⓪ ⓪ ⓪8(* misc. *)⓪8(* ===== *)⓪(⓪ (* getCharSize -- Liefert die Breite 'w' und Höhe 'h' einer Zeichenzelle⓪!* und den Abstand von der topline zur baseline 'tb' und⓪!* größtes und kleinstes Zeichen des aktuellen Fonts.⓪!*)⓪ ⓪ PROCEDURE getCharSize (VAR w, h, tb: CARDINAL; VAR minADE, maxADE: CHAR);⓪ ⓪"VAR min, max : CARDINAL;⓪*bottom, top : CARDINAL;⓪*width : INTEGER;⓪"⓪"BEGIN⓪$GetFaceInfo (device, min,max, bottom,voidC,voidC,voidC, top,⓪1width ,voidI,voidI,voidI);⓪0⓪$minADE := CHR (min); maxADE := CHR (max);⓪$tb := CARDINAL (top);⓪$w := CARDINAL (width);⓪$h := CARDINAL (bottom) + tb + 1; (* Topline selber mitzählen *)⓪"END getCharSize;⓪ ⓪ PROCEDURE setFont (hdl, size: INTEGER);⓪"VAR c: CARDINAL;⓪"BEGIN⓪$SetTextFace (device, hdl);⓪$SetAbsTHeight (device, size, c, c, c, c); (* Größe setzen *)⓪"END setFont;⓪ ⓪ PROCEDURE getCharSizes (hdl: ptrWindow);⓪"VAR w, h, tb : CARDINAL;⓪"BEGIN⓪$WITH hdl^ DO⓪&getCharSize(w, h, tb, minADE, maxADE);⓪&charW := INTEGER (w);⓪&charH := INTEGER (h);⓪&topToBase := INTEGER (tb);⓪$END⓪"END getCharSizes;⓪ ⓪ ⓪8(* calc. proc.s *)⓪8(* ============ *)⓪ ⓪ (* buffer *)⓪ ⓪ (* pointToCharPos - Berechnet die Zeichenposition, die dem Bildschirm-⓪!* pixel 'p' entspricht. Liegt 'p' nicht in 'hdl', so⓪!* ist 'success = FALSE'.⓪!* Dabei überschreiten die Ergebnisse nie die maximal⓪!* Werte für Zeilen- und Spaltenposition.⓪!*)⓪!⓪ PROCEDURE pointToCharPos ( hdl :ptrWindow;⓪>p :Point;⓪:VAR column,⓪>row : CARDINAL;⓪:VAR success: BOOLEAN);⓪ ⓪"VAR lp: LongPnt;⓪"⓪"BEGIN⓪$WITH hdl^ DO⓪$⓪&WindowBase.CalcWindowCoor (handle, p, lp, success);⓪&IF NOT success THEN RETURN END;⓪&⓪&column := CARDINAL (SHORT (lp.x DIV LONG (charW)));⓪&row := CARDINAL (SHORT (lp.y DIV LONG (charH)));⓪&IF column >= hdl^.columns THEN column := hdl^.columns - 1 END;⓪&IF row >= hdl^.rows THEN row := hdl^.rows - 1 END;⓪&⓪$END;⓪"END pointToCharPos;⓪"⓪ (* charToPointPos - Calculates the real pixel coor.s of the char. coor.s⓪!* (column/row).⓪!*)⓪!⓪ PROCEDURE charToPointPos (hdl: ptrWindow; column, row: CARDINAL): Point;⓪ ⓪"VAR result: Point;⓪"⓪"BEGIN⓪$WITH hdl^ DO⓪&WindowBase.CalcScreenCoor (handle,⓪ALPnt (LONG (INTEGER (column)) * LONG (charW),⓪GLONG (INTEGER (row)) * LONG (charH)),⓪Aresult, voidO);⓪$END;⓪$RETURN result⓪"END charToPointPos;⓪ ⓪ (* textBufferIndex - Calc.s the index in the text buffer for the char.⓪!* pos. specified.⓪!*)⓪ ⓪ PROCEDURE textBufferIndex (hdl: ptrWindow; column, row: CARDINAL): bufRange;⓪ ⓪"VAR (* $Reg*)a, b : CARDINAL;⓪"⓪"BEGIN⓪$IF (column >= hdl^.columns) OR (row >= hdl^.rows) THEN RETURN 0 END;⓪$WITH hdl^ DO⓪&a := textOrg + row * columns + column;⓪&b := rows * columns;⓪$END;⓪$IF a >= b THEN RETURN a - b ELSE RETURN a END;⓪"END textBufferIndex;⓪ ⓪ ⓪8(* misc. gem proc.s *)⓪8(* ================ *)⓪ ⓪ PROCEDURE connectToGem (): BOOLEAN;⓪ ⓪"VAR w, h : CARDINAL;⓪"VAR c : CHAR;⓪*proc : EventProc;⓪*success : BOOLEAN;⓪*devpar : PtrDevParm;⓪*mode : WritingMode;⓪*hor : THorJust;⓪*vert : TVertJust;⓪ ⓪"BEGIN⓪$SysInitGem(RC,device, success);⓪$IF success THEN⓪$⓪&gemHdl := CurrGemHandle ();⓪&⓪&AESWindows.UpdateWindow (TRUE);⓪&⓪&IF GDOSAvailable () THEN⓪(LoadFonts (device, 0, Fonts)⓪&ELSE⓪(Fonts:= 0;⓪&END;⓪&devpar:= DeviceParameter (device);⓪&INC (Fonts, devpar^.fonts); (* Anzahl der Fonts: Systemfonts mitzählen *)⓪&⓪&IF StdFontHeight = 0 THEN⓪((* Systemfont ermitteln *)⓪(GetTextStyle (device, StdFontHdl, w, w, hor, vert, mode, ⓪0stdCharW, stdCharH, w, w);⓪(getCharSize (w, h, StdFontHeight, c, c);⓪&END;⓪&⓪&SetTextColor (device, white);⓪&SetTextEffects (device, TEffectSet{});⓪&SetFillPerimeter (device, FALSE);⓪&⓪&GrafMouse (arrow, NIL);⓪&⓪&AESWindows.UpdateWindow (FALSE);⓪&⓪$END;⓪$RETURN success⓪"END connectToGem;⓪ ⓪ PROCEDURE deConnectFromGem;⓪ ⓪"BEGIN⓪%ExitGem (gemHdl);⓪%gemHdl := GemHandle (0);⓪"END deConnectFromGem;⓪"⓪ (* saveCurrHdl -- Rettet das aktuelle GEM-Hdl. in 'saveArea' und setzt⓪!* stattdessen das handle von 'TextWindows' ein. Tritt⓪!* beim Setzen ein Fehler auf, so wird ein Laufzeitfehler⓪!* ausgelößt.⓪!*)⓪ ⓪ PROCEDURE saveCurrHdl (VAR saveArea : GemHandle);⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(JSR CurrGemHandle⓪(MOVE.L -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.L D0,(A0)⓪(⓪(MOVE.L gemHdl,(A3)+⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(JSR SetCurrGemHandle⓪(TST.W (A7)+⓪(BNE ende⓪(⓪(TRAP #noErrorTrap⓪(DC.W GeneralErr - $E000⓪(ACZ "TextWindows:Can't set own GEMHdl"⓪(SYNC⓪(⓪ ende⓪$END;⓪"END saveCurrHdl;⓪"(*$L=*)⓪ ⓪ (* restoreCurrHdl -- Setzt 'saveArea' als GEM-Hdl. ein. Falls dabei ein⓪!* Fehlere auftritt, wird ein Laufzeitfehler ausgelößt.⓪!*)⓪(⓪ PROCEDURE restoreCurrHdl (saveArea : GemHandle);⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(TST.L -4(A3)⓪(BEQ ende ; jump, if 'saveArea = noGem'⓪(⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(JSR SetCurrGemHandle⓪(TST.W (A7)+⓪(BNE ende⓪(⓪(TRAP #noErrorTrap⓪(DC.W GeneralErr - $E000⓪(ACZ "TextWindows:Can't set old GEMHdl"⓪(SYNC⓪(⓪ ende⓪$END;⓪"END restoreCurrHdl;⓪"(*$L=*)⓪ ⓪ ⓪8(* pipes *)⓪8(* ===== *)⓪ ⓪ (* createPipe -- Alloc.s and init.s a new pipe.⓪!* 'success = FALSE', if out of memory.⓪!*)⓪!⓪ PROCEDURE createPipe (VAR p: pipe; VAR success: BOOLEAN);⓪ ⓪"BEGIN⓪$SysAlloc (p, SIZE (p^));⓪$success := (p # NIL);⓪$IF ~ success THEN RETURN END;⓪$⓪$WITH p^ DO⓪&head := 1;⓪&tail := 1;⓪$END;⓪"END createPipe;⓪ ⓪ (* deletePipe -- Dealloc.s pipe.⓪!*)⓪!⓪ PROCEDURE deletePipe (VAR p: pipe);⓪ ⓪"BEGIN⓪$DEALLOCATE (p, SIZE (p^));⓪"END deletePipe;⓪ ⓪ (* pipeFull -- Returns, if the pipe is full (further insertions would be⓪!* ignored).⓪!*)⓪!⓪ PROCEDURE pipeFull (p: pipe): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN p^.tail = p^.head MOD pipeMax + 1⓪"END pipeFull;⓪ ⓪ (* pipeEmpty -- Returns, if the pipe is empty (further read operations⓪!* would be ignored.⓪!*)⓪!⓪ PROCEDURE pipeEmpty (p: pipe): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN p^.head = p^.tail⓪"END pipeEmpty;⓪ ⓪ (* writeIntoPipe -- Writes one character into the pipe, if it is none full,⓪!* else the call is ignored.⓪!*)⓪ ⓪ PROCEDURE writeIntoPipe (VAR p: pipe; ch: CHAR);⓪ ⓪"BEGIN⓪$IF ~ pipeFull (p)⓪$THEN⓪&WITH p^ DO⓪(data[head] := ch;⓪(head := head MOD pipeMax + 1;⓪&END;⓪$END;⓪"END writeIntoPipe;⓪ ⓪ (* readFromPipe -- Reads the element from the pipe which was inserted first⓪!* (fifo), means the one, that is in there the longest time.⓪!* If the pipe is empty, 0C is returned.⓪!*)⓪ ⓪ PROCEDURE readFromPipe (VAR p: pipe; VAR ch: CHAR);⓪ ⓪"BEGIN⓪$IF ~ pipeEmpty (p)⓪$THEN⓪&WITH p^ DO⓪(ch := data[tail];⓪(tail := tail MOD pipeMax + 1;⓪&END;⓪$ELSE ch := 0C END;⓪"END readFromPipe;⓪"⓪ ⓪8(* misc. managment *)⓪8(* =============== *)⓪ ⓪ PROCEDURE isValid (hdl: ptrWindow; errorMsg: BOOLEAN): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(JSR careOfTime ; evtl. zeitabhänige Proc. aufrufen⓪(⓪(MOVE.W -(A3),D1⓪(MOVE.L -(A3),A0⓪(CMPA.L #NIL,A0⓪(BNE cont⓪(; ???? Falls hier etwas eingesetzt wird, muß body geändert werden⓪(MOVE.W #FALSE,(A3)+⓪(BRA return⓪ cont⓪(MOVE.L A0,D0⓪(AND.W #$FFFE,D0 ; Keine ungeraden Adr. zulassen⓪(MOVE.L D0,A0⓪(MOVE.L window.magic(A0),D0⓪(CMP.L #windowMagic,D0⓪(BEQ cont2⓪(TST.W D1⓪(BEQ noMsg ; keinen Laufzeitfehler auslösen⓪(TRAP #noErrorTrap⓪(DC.W IllegalPointer⓪ noMsg MOVE.W #FALSE,(A3)+⓪(BRA return⓪ cont2⓪(MOVE.W #TRUE,(A3)+⓪ return⓪$END;⓪"END isValid;⓪"(*$L=*)⓪"⓪ PROCEDURE notValid (hdl: Window; errorMsg: BOOLEAN): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(JSR isValid⓪(EORI.W #1,-2(A3)⓪$END;⓪"END notValid;⓪"(*$L=*)⓪"⓪ PROCEDURE isMagicOrNIL (hdl: ptrWindow): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -4(A3),D0⓪(BNE cont⓪(SUBQ.L #4,A3⓪(MOVE.W #TRUE,(A3)+⓪(BRA ende⓪ ⓪ cont MOVE.W #TRUE,(A3)+⓪(JSR isValid⓪ ende⓪$END;⓪"END isMagicOrNIL;⓪"(*$L=*)⓪ ⓪ ⓪8(* misc. window managment proc.s *)⓪8(* ============================= *)⓪ ⓪ (* isHidden -- Returns 'TRUE', if 'hdl's window is not visible.⓪!*)⓪!⓪ PROCEDURE isHidden (hdl: ptrWindow): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN WindowBase.hiddenWdw IN WindowBase.WindowFlags (hdl^.handle)⓪"END isHidden;⓪ ⓪ (* isTop -- Returns 'TRUE, if 'hdl's window is the top window.⓪!*)⓪ ⓪ PROCEDURE isTop (hdl: ptrWindow): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN WindowBase.topWdw IN WindowBase.WindowFlags (hdl^.handle)⓪"END isTop;⓪ ⓪ (* setPosAndSize -- Sets the current window position and size.⓪!* The parm.s are in char. coor.s and the special⓪!* values 'CenterWindow' and 'MaxWindow' are allowed.⓪!*)⓪ ⓪ PROCEDURE setPosAndSize (hdl: ptrWindow; x, y, w, h: INTEGER);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪&IF x = CenterWindow THEN x := WindowBase.CenterWdw ELSE x := x * INT(stdCharW) END;⓪&IF y = CenterWindow THEN y := WindowBase.CenterWdw ELSE y := y * INT(stdCharH) END;⓪&IF w = MaxWindow THEN w := WindowBase.MaxWdw ELSE w := w * charW END;⓪&IF h = MaxWindow THEN h := WindowBase.MaxWdw ELSE h := h * charH END;⓪&WindowBase.SetWindowWorkArea (handle, Rect (x, y, w, h));⓪$END⓪"END setPosAndSize;⓪"⓪"⓪8(* VT52-Emulator, Part I *)⓪8(* ===================== *)⓪ ⓪ (* escAutomat -- Does one step of the finite automat for the VT52-Emulator.⓪!*⓪!* in: 'status' - current automat state⓪!* 'ch' - char to accept⓪!*⓪!* out: 'status' - new automat state⓪!* 'result' - generated data (VT52-Comand)⓪!*⓪!* fct: Calculates the new automat state and generates a⓪!* VT52-Comand, while accepting 'ch'.⓪!*)⓪!⓪ PROCEDURE escAutomat (VAR status: escStatusDesc;⓪:inCh : CHAR;⓪6VAR result: escResultDesc);⓪ ⓪"BEGIN⓪$WITH result DO⓪$⓪&comand := nothingEsc;⓪&ch := null;⓪&⓪&CASE status.state OF⓪&⓪(normalEsc: IF inCh = esc THEN status.state := escEsc⓪3ELSE ch := inCh; comand := normalCharEsc END|⓪(⓪(escEsc : status.state := normalEsc;⓪3CASE inCh OF⓪(⓪5ctrlE: comand := enhanceOnEsc|⓪5ctrlF: comand := enhanceOffEsc|⓪5ctrlP: comand := flushEsc|⓪(⓪5'A' : comand := cursUpEsc|⓪5'B' : comand := cursDownEsc|⓪5'C' : comand := cursRightEsc|⓪5'D' : comand := cursLeftEsc|⓪5'E' : comand := clsEsc|⓪5'H' : comand := homeEsc|⓪5'J' : comand := eraseEOPEsc|⓪5'I' : comand := reverseLfEsc|⓪5'K' : comand := clrEOLEsc|⓪5'L' : comand := insLnEsc|⓪5'M' : comand := delLnEsc|⓪5'Y' : status.state := gotoYEsc|⓪5'b' : status.state := fgEsc|⓪5'c' : status.state := bgEsc|⓪5'd' : comand := eraseBegDispEsc|⓪5'e' : comand := cursOnEsc|⓪5'f' : comand := cursOffEsc|⓪5'j' : comand := saveCursPosEsc|⓪5'k' : comand := restoreCursPosEsc|⓪5'l' : comand := eraseLnEsc|⓪5'o' : comand := eraseBegLnEsc|⓪5'p' : comand := reverseOnEsc|⓪5'q' : comand := reverseOffEsc|⓪5'v' : comand := wrapOnEsc|⓪5'w' : comand := wrapOffEsc|⓪5⓪3END|⓪3⓪(gotoXEsc : IF (inCh >= space) AND (status.first >= space)⓪3THEN⓪5x := ORD (inCh) - ORD (space);⓪5y := ORD (status.first) - ORD (space);⓪5comand := gotoXYEsc;⓪3END;⓪3status.state := normalEsc|⓪3⓪(gotoYEsc : status.first := inCh;⓪3status.state := gotoXEsc|⓪3⓪(fgEsc : IF (ORD (inCh) >= ORD ('0')) AND (ORD (inCh) <= ORD ('?'))⓪2THEN⓪4fgCol := ORD (inCh) - ORD ('0');⓪4comand := fgColEsc;⓪2END;⓪2status.state := normalEsc|⓪2⓪(bgEsc : IF (ORD (inCh) >= ORD ('0')) AND (ORD (inCh) <= ORD ('?'))⓪2THEN⓪4bgCol := ORD (inCh) - ORD ('0');⓪4comand := bgColEsc;⓪2END;⓪2status.state := normalEsc|⓪&⓪&END;⓪&⓪$END;⓪"END escAutomat;⓪ ⓪ ⓪8(* buffer reading proc.s *)⓪8(* ===================== *)⓪ ⓪ (* window server *)⓪ ⓪ PROCEDURE update (wdw : WindowBase.Window;⓪2env : ADDRESS;⓪2source,⓪2dest,⓪2new : Rectangle);⓪ ⓪"VAR hdl : ptrWindow;⓪(oldHdl : GemHandle;⓪(⓪(currElemPtr : ptrBufferElem;⓪(l, t, r, b, c : CARDINAL;⓪(dRev : effectSet;⓪(p : Point;⓪(collectSpaces : BOOLEAN;⓪((* $Reg*)x, j, sp,⓪0row : CARDINAL;⓪"⓪"BEGIN⓪$IF source.w # 0 THEN⓪&DisableClipping (device);⓪&CopyOpaque (device, ADR (stdMFDB), ADR (stdMFDB), source, dest, onlyS);⓪$END;⓪$⓪$IF (new.w <= 0) OR (new.h <= 0) THEN RETURN END;⓪$⓪$hdl := ptrWindow (env);⓪$saveCurrHdl (oldHdl);⓪$⓪$WITH hdl^ DO⓪&⓪&pointToCharPos (hdl, Pnt (new.x, new.y), l, t, voidO);⓪&pointToCharPos (hdl, Pnt (new.x + new.w - 1, new.y + new.h - 1),⓪6r, b, voidO);⓪&⓪&SetWritingMode (device, replaceWrt);⓪&SetFillType (device, solidFill);⓪&SetFillColor (device, bgCol);⓪&SetClipping (device, new);⓪&FillRectangle (device, new);⓪&⓪&SetTextColor (device, fgCol);⓪&setFont (fontHdl, topToBase);⓪&⓪&FOR row := t TO b DO⓪&⓪(currElemPtr := ADR (buffer^[textBufferIndex (hdl, l, row)]);⓪(x := l;⓪(REPEAT⓪(⓪*j := 0; sp := 0;⓪*p := charToPointPos (hdl, x, row);⓪*dRev := currElemPtr^.effects;⓪*REPEAT⓪,redrawStr^[j] := currElemPtr^.ch;⓪,IF (redrawStr^[j] < minADE)⓪/OR (redrawStr^[j] > maxADE)⓪,THEN⓪.redrawStr^[j] := ' ';⓪,END;⓪*⓪,IF redrawStr^[j] = ' ' THEN INC (sp) ELSE sp := 0 END;⓪,collectSpaces := (sp > 2);⓪-⓪,INC (currElemPtr, SIZE (currElemPtr^)); INC (x); INC (j);⓪*UNTIL (x > r) OR (dRev # currElemPtr^.effects) OR collectSpaces;⓪*⓪*IF NOT collectSpaces THEN sp := 0 END;⓪*redrawStr^[j - sp] := 0C;⓪*IF redrawStr^[0] # 0C THEN⓪*⓪,p.y := p.y + topToBase;⓪,⓪,(* Achtung: String hat 'MaxCard + 1' Elemente (REF nötig) *)⓪,grafText (device, p, redrawStr^, dRev);⓪*⓪*END;⓪*IF collectSpaces THEN⓪*⓪,DEC (x, sp); DEC (currElemPtr, SHORT (SIZE (currElemPtr^)) * sp);⓪,sp := 0;⓪,p := charToPointPos (hdl, x, row);⓪,REPEAT⓪.INC (currElemPtr, SIZE (currElemPtr^)) ; INC (x) ; INC (sp);⓪,UNTIL (x > r) OR (dRev # currElemPtr^.effects)⓪2OR (currElemPtr^.ch # ' ');⓪2⓪,IF inverse IN dRev THEN⓪.SetFillColor (device, fgCol);⓪.FillRectangle (device, Rect (p.x, p.y,⓪KINTEGER (sp) * charW, charH));⓪,END;⓪*⓪*END;⓪*⓪(UNTIL x > r;⓪(⓪&END;(*FOR*)⓪&⓪&DisableClipping (device);⓪#⓪$END;(*WITH*)⓪"⓪$restoreCurrHdl (oldHdl);⓪"END update;⓪ ⓪ PROCEDURE activated (wdw: WindowBase.Window; env: ADDRESS);⓪ ⓪"END activated;⓪ ⓪ PROCEDURE close (wdw: WindowBase.Window; env: ADDRESS);⓪ ⓪"VAR hdl: ptrWindow;⓪ ⓪"BEGIN⓪$hdl := ptrWindow (env);⓪$⓪$hdl^.closed := TRUE;⓪"END close;⓪ ⓪ PROCEDURE checkSpec ( wdw : WindowBase.Window;⓪9env : ADDRESS;⓪5VAR spec : WindowBase.WindowSpec;⓪9border: LongRect );⓪"⓪"CONST charAlign = 8L;⓪"⓪"VAR hdl: ptrWindow;⓪(amt: LONGINT;⓪$⓪"BEGIN⓪$hdl := ptrWindow (env);⓪$⓪$WITH spec DO⓪$⓪&WITH hdl^ DO⓪(IF visible.w > LONG (INTEGER (columns)) * LONG (charW)⓪(THEN visible.w := LONG (INTEGER (columns)) * LONG (charW) END;⓪(IF visible.h > LONG (INTEGER (rows)) * LONG (charH)⓪(THEN visible.h := LONG (INTEGER (rows)) * LONG (charH) END;⓪&END;⓪&⓪&(* Umrechnen in Weltkoor.⓪'*)⓪&INC (virtual.x, visible.x);⓪&INC (virtual.y, visible.y);⓪&⓪&border.w := border.x + border.w - 1L;⓪&border.h := border.y + border.h - 1L;⓪&IF virtual.x < border.x THEN virtual.x := border.x END;⓪&IF virtual.y < border.y THEN virtual.y := border.y END;⓪&IF virtual.x > border.w THEN virtual.x := border.w END;⓪&IF virtual.y > border.h THEN virtual.y := border.h END;⓪&(* 'visible' erst nach _korrigiertem_ 'virtual' bestimmen: 14.01.94 TT *)⓪&visible.w := virtual.x + visible.w - 1L;⓪&visible.h := virtual.y + visible.h - 1L;⓪&IF visible.w < border.x THEN visible.w := border.x END;⓪&IF visible.h < border.y THEN visible.h := border.y END;⓪&IF visible.w > border.w THEN visible.w := border.w END;⓪&IF visible.h > border.h THEN visible.h := border.h END;⓪&visible.w := visible.w - virtual.x + 1L;⓪&visible.h := visible.h - virtual.y + 1L;⓪&⓪&INC (virtual.x, charAlign - 1L); DEC (virtual.x, virtual.x MOD charAlign);⓪&⓪&DEC (virtual.x, visible.x);⓪&DEC (virtual.y, visible.y);⓪&⓪&WITH hdl^ DO⓪(amt := visible.x MOD LONG (charW);⓪(INC (virtual.x, amt); DEC (visible.x, amt);⓪(amt := visible.y MOD LONG (charH);⓪(INC (virtual.y, amt); DEC (visible.y, amt);⓪(⓪(DEC (visible.w, visible.w MOD LONG (charW));⓪(DEC (visible.h, visible.h MOD LONG (charH));⓪&END⓪$END;⓪"END checkSpec;⓪ ⓪ PROCEDURE scrollAmt (wdw : WindowBase.Window;⓪5env : ADDRESS;⓪5toDo : WindowBase.WindowScrollMode): LONGINT;⓪2⓪"VAR spec: WindowBase.WindowSpec; w: ptrWindow;⓪"⓪"BEGIN⓪$w:= env;⓪$WindowBase.GetWindowSpec (wdw, spec);⓪$CASE toDo OF⓪&WindowBase.pageLeftWdw,⓪&WindowBase.pageRightWdw : RETURN spec.visible.w|⓪&WindowBase.pageUpWdw,⓪&WindowBase.pageDownWdw : RETURN spec.visible.h|⓪&WindowBase.columnLeftWdw,⓪&WindowBase.columnRightWdw: RETURN LONG (w^.charW)|⓪&WindowBase.rowUpWdw,⓪&WindowBase.rowDownWdw : RETURN LONG (w^.charH)|⓪$END;⓪"END scrollAmt;⓪ ⓪ ⓪ (* misc. *)⓪ ⓪ PROCEDURE takeCareOfForce (hdl: ptrWindow);⓪ ⓪"CONST horPuffer = 4;⓪*vertPuffer = 1;⓪"⓪"PROCEDURE adjust (puffer :INTEGER;⓪4minP, maxP,⓪4smallP, highP,⓪4targetP :CARDINAL) :INTEGER;⓪"⓪$VAR (* $Reg*) result : INTEGER;⓪*min, max, small,⓪*high, target : INTEGER;⓪*left, right : BOOLEAN;⓪$⓪$BEGIN⓪&min := INTEGER (minP); max := INTEGER (maxP);⓪&small := INTEGER (smallP); high := INTEGER (highP);⓪&target := INTEGER (targetP);⓪&⓪&left := ((small + puffer) > target);⓪&right := ((high - puffer) < target);⓪&IF left = right THEN RETURN 0⓪&ELSIF left THEN result := target - small - 2 * puffer⓪&ELSE result:=target - high + 2 * puffer END;⓪&⓪&IF (small + result) < min THEN result := min - small END;⓪&IF (high + result) > max THEN result := max - high END;⓪&⓪&RETURN result;⓪$END adjust;⓪"⓪"VAR right, bottom,⓪*left, top : CARDINAL;⓪*rowAmt, colAmt : INTEGER;⓪*spec : WindowBase.WindowSpec;⓪*(* $Reg*)changed: BOOLEAN;⓪"⓪"BEGIN⓪$IF isHidden (hdl) THEN RETURN END;⓪$⓪$WITH hdl^ DO⓪%IF force # noForce THEN⓪$⓪&IF NOT isTop (hdl) THEN⓪(WindowBase.PutWindowOnTop (handle);⓪(FlushEvents; (* Gib AES Zeit für redraw message *)⓪&END;⓪&⓪&IF (force = forceCursor) OR (force = forceLine) THEN⓪*⓪(WindowBase.GetWindowSpec (handle, spec);⓪(left := CARDINAL (SHORT (spec.visible.x DIV LONG (charW)));⓪(top := CARDINAL (SHORT (spec.visible.y DIV LONG (charH)));⓪(right := left + CARDINAL (SHORT (spec.visible.w DIV LONG (charW))) - 1;⓪(bottom := top + CARDINAL (SHORT (spec.visible.h DIV LONG (charH))) - 1;⓪(⓪(IF force = forceCursor THEN⓪*colAmt := adjust (horPuffer, 0, columns - 1, left, right,⓪<cursX) * charW⓪(ELSE⓪*colAmt := 0⓪(END;⓪(rowAmt := adjust (vertPuffer, 0, rows - 1, top, bottom, cursY)⓪2* charH;⓪(⓪(IF (SHORT (spec.visible.x) + colAmt) < 0⓪(THEN⓪*changed := (spec.visible.w # 0L);⓪*spec.visible.x := 0L;⓪(ELSE⓪*changed := (colAmt # 0);⓪*INC (spec.visible.x, colAmt);⓪(END;⓪(IF (SHORT (spec.visible.y) + rowAmt) < 0 THEN⓪*changed := changed OR (spec.visible.y # 0L);⓪*spec.visible.y := 0L;⓪(ELSE⓪*changed := changed OR (rowAmt # 0);⓪*INC (spec.visible.y, rowAmt);⓪(END;⓪(IF changed THEN⓪*WindowBase.SetWindowSliderPos (handle,⓪Ispec.visible.x, spec.visible.y);⓪(END;⓪*⓪&END;⓪&⓪%END;⓪$END;⓪"END takeCareOfForce;⓪"⓪ PROCEDURE doWaitingRedraws (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO WITH redrawArea DO⓪$⓪&IF w # 0 THEN⓪(WindowBase.UpdateWindow (handle, update, hdl,⓪ALRect (LONG (x) * LONG (charW),⓪HLONG (y) * LONG (charH),⓪HLONG (w) * LONG (charW),⓪HLONG (h) * LONG (charH)),⓪AWindowBase.noCopyWdw, 0L);⓪(w := 0;⓪&END;⓪&⓪$END END;⓪$takeCareOfForce (hdl);⓪"END doWaitingRedraws;⓪"⓪8(* redraw pipe proc.s *)⓪8(* ================== *)⓪ ⓪ (* addRedrawArea -- Adds a new area, to the area(s), that have to be⓪!* redrawn. 'area' contains virtual char. coor.s.⓪!* May call the redraw proc.⓪!*)⓪ ⓪ PROCEDURE addRedrawArea (hdl: ptrWindow; area: Rectangle);⓪ ⓪"VAR new: Rectangle;⓪"⓪"BEGIN⓪$WITH hdl^ DO⓪$⓪&IF redrawArea.w = 0 THEN redrawArea := area⓪&ELSE⓪&⓪(new := FrameRects (redrawArea, area);⓪(IF LONG (new.w) * LONG (new.h)⓪+> 2L * (LONG (area.w) * LONG (area.h)⓪3+ LONG (redrawArea.w) * LONG (redrawArea.h))⓪(THEN⓪*doWaitingRedraws (hdl); redrawArea := area⓪(ELSE⓪*redrawArea := new⓪(END;⓪(⓪&END;⓪&⓪$END;⓪"END addRedrawArea;⓪"⓪"⓪8(* buffer writing proc.s *)⓪8(* ===================== *)⓪ ⓪ (* out of write pipe *)⓪ ⓪ (* writeSpaceBlock - Der angegebene Bereich zwischen den beiden Zeichen⓪!* positionen wird mit spaces aufgefüllt. Cursorsicht-⓪!* barkeit und -position wird nicht beachtet.⓪!* 'suppressRedraw = TRUE' bedeutet, daß der Bereich⓪!* zwar mit Leerzeichen aufgefüllt wird, aber nicht⓪!* in die noch neuzuzeichnenden Bereiche eingetragen⓪!* wird.⓪!*)⓪ ⓪ PROCEDURE writeSpaceBlock (hdl : ptrWindow;⓪;left,⓪;top,⓪;right,⓪;bottom : CARDINAL;⓪;suppressRedraw: BOOLEAN);⓪ ⓪"VAR i : bufRange;⓪*j, line: CARDINAL;⓪*elem : bufferElem;⓪ ⓪"BEGIN⓪$elem.ch := ' ';⓪$elem.effects := effectSet{};⓪$IF hdl^.revMode THEN INCL (elem.effects, inverse) END;⓪$⓪$FOR line := top TO bottom DO⓪$⓪&i := textBufferIndex (hdl, left, line);⓪&FOR j := 1 TO right - left + 1 DO hdl^.buffer^[i] := elem; INC (i) END;⓪&⓪$END;⓪$⓪$IF NOT suppressRedraw⓪$THEN⓪&addRedrawArea (hdl, Rect (left, top, right - left + 1, bottom - top + 1));⓪$END;⓪"END writeSpaceBlock;⓪ ⓪ PROCEDURE scrollUp (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪$⓪&(* clear top row, cause it becomes the new bottom row.⓪'*)⓪&writeSpaceBlock (hdl, 0, 0, columns - 1, 0, TRUE);⓪E⓪&(* move waiting redraws⓪'*)⓪&WITH redrawArea DO⓪(IF y > 0 THEN DEC (y) ELSE DEC (h) END;⓪&END;⓪&⓪&IF textOrg >= ((rows - 1) * columns) THEN⓪(textOrg := 0;⓪&ELSE⓪(textOrg := textOrg + columns⓪&END;⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);⓪&⓪&WindowBase.UpdateWindow (handle, update, hdl,⓪?LRect (0L, 0L,⓪FLONG (INTEGER (columns)) * LONG (charW),⓪FLONG (INTEGER (rows)) * LONG (charH)),⓪?WindowBase.copyVertWdw, LONG (-charH) );⓪E⓪$END;⓪"END scrollUp;⓪"⓪ PROCEDURE scrollDown (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪&⓪&(* clear bottom row, cause it becomes the new top row.⓪'*)⓪&writeSpaceBlock (hdl, 0, rows - 1, columns - 1, rows - 1, TRUE);⓪ ⓪&(* move waiting redraws⓪'*)⓪&WITH redrawArea DO⓪(INC (y);⓪(IF y + h > INTEGER (rows) - 1 THEN DEC (h) END;⓪&END;⓪&⓪&IF textOrg = 0 THEN⓪(textOrg := (rows - 1) * columns⓪&ELSE⓪(textOrg := textOrg - columns⓪&END;⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);⓪&⓪&WindowBase.UpdateWindow (handle, update, hdl,⓪?LRect (0L, 0L,⓪FLONG (INTEGER (columns)) * LONG (charW),⓪FLONG (INTEGER (rows)) * LONG (charH)),⓪?WindowBase.copyVertWdw, LONG (charH) );⓪ ⓪$END;⓪"END scrollDown;⓪ ⓪ PROCEDURE cursorOff (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪&IF noCursHides = 0 THEN⓪&⓪(IF cursX < columns THEN⓪*WITH buffer^[cursIndex] DO effects := effects / effectSet{inverse} END;⓪*addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));⓪(END;⓪(⓪&END;⓪&INC (noCursHides);⓪$END;⓪"END cursorOff;⓪ ⓪ PROCEDURE cursorOn (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪&IF noCursHides = 1 THEN⓪&⓪(IF cursX < columns THEN⓪*WITH buffer^[cursIndex] DO effects := effects + effectSet{inverse} END;⓪*addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));⓪(END;⓪(⓪&END;⓪&DEC (noCursHides);⓪$END;⓪"END cursorOn;⓪ ⓪ PROCEDURE setCursor (hdl: ptrWindow; col, row: INTEGER);⓪ ⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^ DO⓪$⓪&IF col > INTEGER (columns) THEN cursX := columns - 1⓪&ELSIF col < 0 THEN cursX := 0⓪&ELSE cursX := CARDINAL (col) END;⓪&⓪&IF row >= INTEGER (rows) THEN cursY := rows - 1⓪&ELSIF row < 0 THEN cursY := 0⓪&ELSE cursY := CARDINAL (row) END;⓪&⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);⓪$⓪$END;⓪$⓪$cursorOn (hdl);⓪"END setCursor;⓪"⓪ PROCEDURE clearToEndOfLine (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪$⓪&IF cursX < columns⓪&THEN⓪(cursorOff (hdl);⓪(writeSpaceBlock(hdl, cursX, cursY, columns - 1, cursY, FALSE);⓪(cursorOn (hdl);⓪&END;⓪&⓪$END;⓪"END clearToEndOfLine;⓪ ⓪ PROCEDURE eraseBegOfLine (hdl: ptrWindow);⓪ ⓪"VAR (* $Reg*) oldCursX: CARDINAL;⓪"⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^⓪$DO⓪&oldCursX := cursX;⓪&IF oldCursX = columns THEN DEC (oldCursX) END;⓪&writeSpaceBlock (hdl, 0, cursY, oldCursX, cursY, FALSE);⓪$END;⓪$⓪$cursorOn (hdl);⓪"END eraseBegOfLine;⓪ ⓪ PROCEDURE eraseToEndOfPage (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^ DO⓪&IF cursX < columns THEN⓪(writeSpaceBlock (hdl, cursX, cursY, columns - 1, cursY, FALSE)⓪&END;⓪&IF (cursY + 1) < rows THEN⓪(writeSpaceBlock (hdl, 0, cursY + 1, columns - 1, rows - 1, FALSE)⓪&END;⓪$END;⓪$⓪$cursorOn (hdl);⓪"END eraseToEndOfPage;⓪ ⓪ PROCEDURE eraseBegOfDisp (hdl: ptrWindow);⓪ ⓪"VAR (* $Reg*) oldCursX : CARDINAL;⓪"⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^ DO⓪$⓪&oldCursX := cursX;⓪&IF oldCursX = columns THEN DEC (oldCursX) END;⓪&writeSpaceBlock (hdl, 0, cursY, oldCursX, cursY, FALSE);⓪&IF cursY > 0 THEN⓪(writeSpaceBlock (hdl, 0, 0, columns - 1, cursY - 1, FALSE);⓪&END;⓪&⓪$END;⓪$⓪$cursorOn (hdl);⓪"END eraseBegOfDisp;⓪ ⓪ PROCEDURE eraseEntireLine (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^⓪$DO⓪&writeSpaceBlock (hdl, 0, cursY, columns - 1, cursY, FALSE);⓪&setCursor (hdl, 0, cursY);⓪$END;⓪$⓪$cursorOn (hdl);⓪"END eraseEntireLine;⓪ ⓪ PROCEDURE cursorHome (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$setCursor (hdl, 0, 0);⓪"END cursorHome;⓪ ⓪ PROCEDURE clearScreen (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$cursorHome (hdl);⓪$eraseToEndOfPage (hdl);⓪"END clearScreen;⓪ ⓪ PROCEDURE insertLine (hdl: ptrWindow);⓪ ⓪"VAR f : Rectangle;⓪1n,⓪((*$Reg*) max,⓪((*$Reg*) i,⓪((*$Reg*) j: CARDINAL;⓪"⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^ DO⓪$⓪&(* Bufferinhalt ab Cursor nach unten schieben.⓪'*)⓪'⓪&max := columns * rows - 1;⓪&IF textOrg = 0 THEN j := max ELSE j := textOrg - 1 END;⓪&IF j < columns THEN i := max - columns + j ELSE i := j - columns END;⓪&FOR n:= 1 TO (rows - 1 - cursY) * columns DO⓪(buffer^[j] := buffer^[i];⓪(IF i = 0 THEN i := max ELSE DEC (i) END;⓪(IF j = 0 THEN j := max ELSE DEC (j) END;⓪&END;⓪'⓪&(* Zeile in der Curs. steht, löschen.⓪'*)⓪$⓪&FOR i := textBufferIndex (hdl, 0,cursY)⓪/TO textBufferIndex (hdl, columns - 1,cursY) DO⓪(WITH buffer^[i] DO⓪*ch := ' ';⓪*effects := effectSet{};⓪*IF hdl^.revMode THEN INCL (effects, inverse) END;⓪(END;⓪&END;⓪&setCursor (hdl, 0, hdl^.cursY);⓪&⓪&(* Fensterinhalt restaurieren.⓪'*)⓪&f.x := 0; f.w := INTEGER (columns) * charW;⓪&f.y := INTEGER (cursY) * charH; f.h := INTEGER (rows) * charH - f.y;⓪&IF (f.y >= 0) AND (f.h > 0) THEN⓪(WindowBase.UpdateWindow (hdl^.handle, update, hdl,⓪ALRect (LONG (f.x), LONG (f.y),⓪HLONG (f.w), LONG (f.h)),⓪AWindowBase.copyVertWdw, charH);⓪&END;⓪(⓪$END;⓪$⓪$cursorOn (hdl);⓪"END insertLine;⓪ ⓪ PROCEDURE deleteLine (hdl: ptrWindow);⓪ ⓪"VAR f : Rectangle;⓪((*$Reg*) i, (*$Reg*) j: CARDINAL;⓪(n, (*$Reg*) max : CARDINAL;⓪"⓪"BEGIN⓪$cursorOff (hdl);⓪$⓪$WITH hdl^ DO⓪$⓪&(* Bufferinhalt ab Cursor nach oben schieben.⓪'*)⓪'⓪&max := columns * rows - 1;⓪&j := textBufferIndex (hdl, 0,cursY);⓪&i := j + columns;⓪&IF i > max THEN i := i - max - 1 END;⓪&FOR n:= 1 TO (rows - 1 - cursY) * columns DO⓪(buffer^[j]:=buffer^[i];⓪(IF i = max THEN i := 0 ELSE INC (i) END;⓪(IF j = max THEN j := 0 ELSE INC (j) END;⓪&END;⓪'⓪&(* Letzte Zeile löschen.⓪'*)⓪$⓪&FOR i := textBufferIndex (hdl, 0,rows - 1) TO⓪/textBufferIndex (hdl, columns - 1,rows - 1) DO⓪(WITH buffer^[i] DO⓪*ch := ' ';⓪*effects := effectSet{};⓪*IF hdl^.revMode THEN INCL (effects, inverse) END;⓪(END;⓪&END;⓪&setCursor (hdl, 0, hdl^.cursY);⓪&⓪&(* Fensterinhalt restaurieren.⓪'*)⓪&f.x := 0; f.w := INTEGER (columns) * charW;⓪&f.y := INTEGER (cursY) * charH; f.h := INTEGER (rows) * charH - f.y;⓪&IF (f.y >= 0) AND (f.h > 0) THEN⓪(WindowBase.UpdateWindow (hdl^.handle, update, hdl,⓪ALRect (LONG (f.x), LONG (f.y),⓪HLONG (f.w), LONG (f.h)),⓪AWindowBase.copyVertWdw, LONG (-charH));⓪&END;⓪$⓪$END;⓪$⓪$cursorOn (hdl);⓪"END deleteLine;⓪"⓪ PROCEDURE doBell;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L #$00020007,-(A7)⓪(MOVE.W #$3,-(A7)⓪(TRAP #13 ; BIOS (3) -- Bconout (2, CHR (7))⓪(ADDQ.W #6,A7⓪$END;⓪"END doBell;⓪"(*$L=*)⓪ ⓪ PROCEDURE initEscAutomat (VAR escStatus: escStatusDesc);⓪ ⓪"BEGIN⓪$escStatus.state := normalEsc;⓪"END initEscAutomat;⓪ ⓪ (* insertIntoBuffer -- Inserts a single character at the current cursor⓪!* position into the text buffer.⓪!* If neccesary, interpretation of control characters.⓪!*)⓪ ⓪ PROCEDURE insertIntoBuffer (hdl: ptrWindow; newCh: CHAR);⓪ ⓪"VAR done : BOOLEAN;⓪(newEffects: effectSet;⓪ ⓪"BEGIN⓪$WITH hdl^ DO⓪"⓪&(* if neccasary, interpret the control characters.⓪'*)⓪'⓪&done := FALSE;⓪&IF (newCh < ' ') AND (ctrlMode = interpretCtrl)⓪&THEN⓪(CASE newCh OF⓪(⓪*bell: doBell; done := TRUE|⓪*⓪*bs : setCursor (hdl, cursX - 1, cursY);⓪0done := TRUE|⓪0⓪*lf : cursorOff (hdl);⓪0IF (cursY + 1) < rows THEN setCursor (hdl, cursX, cursY + 1)⓪0ELSE scrollUp (hdl) END;⓪0cursorOn (hdl);⓪0done := TRUE|⓪0⓪*cr : IF cursX # 0 THEN setCursor (hdl, 0, cursY) END;⓪0done := TRUE|⓪*⓪(END;⓪&END;⓪&⓪&(* if no interpretation, then insert character at cursor position and⓪'* set cursor to new position (includes: insert area into "redraw pipe").⓪'*)⓪&⓪&IF NOT done THEN⓪(⓪(cursorOff (hdl);⓪(⓪(IF cursX >= columns THEN⓪*IF (cursY + 1) = rows THEN scrollUp (hdl) END;⓪*setCursor (hdl, 0, cursY + 1);⓪(END;⓪&⓪(newEffects := effectSet{};⓪(IF revMode THEN INCL (newEffects, inverse) END;⓪(WITH buffer^[cursIndex]⓪(DO⓪*ch := newCh;⓪*effects := newEffects;⓪(END;⓪(addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));⓪(⓪(IF (wrapAround AND (cursX = columns - 1)) OR (cursX < columns - 1) THEN⓪*setCursor (hdl, cursX + 1, cursY);⓪(END;⓪(⓪(cursorOn (hdl);⓪$⓪&END;⓪$⓪$END;⓪"END insertIntoBuffer;⓪"⓪ (* flushWritePipe -- Reads the write pipe of 'hdl' char by char and⓪!* and inserts that char into the esc Automat. De-⓪!* pending on the result of the automat, the text⓪!* buffer is changed and data is written into the⓪!* "redraw pipe".⓪!*)⓪!⓪ PROCEDURE flushWritePipe (hdl: ptrWindow);⓪ ⓪"VAR ch : CHAR;⓪(escResult: escResultDesc;⓪(flush : BOOLEAN;⓪(⓪"BEGIN⓪$flush := FALSE;⓪$WITH hdl^ DO⓪&WHILE NOT pipeEmpty (writePipe) DO⓪$⓪(readFromPipe (writePipe, ch);⓪(escAutomat (escStatus, ch, escResult);⓪(⓪(CASE escResult.comand OF⓪(⓪*nothingEsc : |⓪*normalCharEsc : insertIntoBuffer (hdl, ch)|⓪*⓪*cursUpEsc : setCursor (hdl, cursX, cursY - 1)|⓪*cursDownEsc : setCursor (hdl, cursX, cursY + 1)|⓪*cursLeftEsc : setCursor (hdl, cursX - 1, cursY)|⓪*cursRightEsc : setCursor (hdl, cursX + 1, cursY)|⓪=⓪*clsEsc : clearScreen (hdl)|⓪*homeEsc : cursorHome (hdl)|⓪*eraseEOPEsc : eraseToEndOfPage (hdl)|⓪*⓪*reverseLfEsc : cursorOff (hdl);⓪=IF cursY > 0⓪=THEN setCursor (hdl, cursX, cursY - 1)⓪=ELSE scrollDown (hdl) END;⓪=cursorOn (hdl)|⓪=⓪*clrEOLEsc : clearToEndOfLine (hdl)|⓪*insLnEsc : insertLine (hdl)|⓪*delLnEsc : deleteLine (hdl)|⓪*gotoXYEsc : setCursor (hdl, escResult.x, escResult.y)|⓪*fgColEsc : fgCol := escResult.fgCol|⓪*bgColEsc : bgCol := escResult.bgCol|⓪*eraseBegDispEsc : eraseBegOfDisp (hdl)|⓪*cursOnEsc : IF noCursHides = 1 THEN cursorOn (hdl) END|⓪*cursOffEsc : IF noCursHides = 0 THEN cursorOff (hdl) END|⓪*⓪*saveCursPosEsc : cursXSave := cursX;⓪=cursYSave := cursY|⓪=⓪*restoreCursPosEsc: setCursor (hdl, cursXSave, cursYSave);⓪=cursXSave := 0; cursYSave := 0|⓪=⓪*eraseLnEsc : eraseEntireLine (hdl)|⓪*eraseBegLnEsc : eraseBegOfLine (hdl)|⓪*reverseOnEsc : revMode := TRUE|⓪*reverseOffEsc : revMode := FALSE|⓪*wrapOnEsc : wrapAround := TRUE|⓪*wrapOffEsc : wrapAround := FALSE|⓪*flushEsc : flush := TRUE|⓪*enhanceOffEsc : enhanced := FALSE; flush := TRUE|⓪*enhanceOnEsc : enhanced := TRUE; flush := TRUE|⓪*⓪(END;⓪(⓪&END;⓪&IF NOT enhanced OR flush THEN doWaitingRedraws (hdl) END;⓪$END;⓪"END flushWritePipe;⓪"⓪ ⓪ (* into write pipe *)⓪ ⓪ (* insertIntoWritePipe -- Appends a string to a windows write pipe and⓪!* checks for enhanced or flush esc sequences.⓪!* Calls write pipe flush proc.⓪!*)⓪ ⓪ PROCEDURE insertIntoWritePipe (hdl: Window; REF str: ARRAY OF CHAR);⓪ ⓪"VAR (* $Reg*) i: CARDINAL;⓪(escResult : escResultDesc;⓪(⓪"BEGIN⓪$WITH hdl^ DO⓪$⓪&i := 0;⓪&WHILE (i <= HIGH (str)) AND (str[i] # 0C) DO⓪&⓪(IF pipeFull (writePipe) THEN flushWritePipe (hdl) END;⓪(writeIntoPipe (writePipe, str[i]);⓪(⓪(escAutomat (pipeEscStatus, str[i], escResult);⓪(IF (escResult.comand = flushEsc) OR (escResult.comand = enhanceOffEsc)⓪+OR (escResult.comand = enhanceOnEsc)⓪(THEN flushWritePipe (hdl) END;⓪(⓪(INC (i);⓪&END;⓪&IF NOT enhanced THEN flushWritePipe (hdl) END;⓪&⓪$END;⓪"END insertIntoWritePipe;⓪ ⓪ ⓪8(* misc. help proc.s *)⓪8(* ================= *)⓪ ⓪ (* internal... -- These proc.s are used to execute some esc sequences,⓪!* without using the 'writePipe', to avoid conflict with⓪!* user esc sequences.⓪!* They are for internal use only and flush all pipes.⓪!*)⓪ ⓪ PROCEDURE internalFlushPipe (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$flushWritePipe (hdl);⓪$doWaitingRedraws (hdl);⓪"END internalFlushPipe;⓪ ⓪ PROCEDURE internalCursorOn (hdl: ptrWindow);⓪"VAR oldForce: ForceMode;⓪"BEGIN⓪$oldForce:= hdl^.force;⓪$hdl^.force:= forceCursor;⓪$flushWritePipe (hdl);⓪$cursorOn (hdl);⓪$doWaitingRedraws (hdl);⓪$hdl^.force:= oldForce⓪"END internalCursorOn;⓪"⓪ PROCEDURE internalCursorOff (hdl: ptrWindow);⓪ ⓪"BEGIN⓪$flushWritePipe (hdl);⓪$cursorOff (hdl);⓪$doWaitingRedraws (hdl);⓪"END internalCursorOff;⓪ ⓪ PROCEDURE myShow (hdl: Window);⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$IF isHidden (hdl) THEN⓪&internalFlushPipe (hdl);⓪&WindowBase.OpenWindow (hdl^.handle);⓪$END;⓪$FlushEvents;⓪"END myShow;⓪ ⓪8(* exported proc.s *)⓪8(* =============== *)⓪ ⓪ (* managmant proc.s (ignoring pipe and similiar objects) *)⓪ ⓪ PROCEDURE Open (VAR hdl : Window; newColumns, newRows: CARDINAL;⓪4qualities : WQualitySet; mode : ShowMode;⓪4newForce : ForceMode; wName : ARRAY OF CHAR;⓪4colOrg, rowOrg : INTEGER; wOrg, hOrg : INTEGER;⓪0VAR success : BOOLEAN);⓪ ⓪"VAR a : LONGCARD;⓪(maxPnt : Point;⓪(elems : WindowBase.WdwElemSet;⓪(spec : WindowBase.WindowSpec;⓪(oldGem : RECORD⓪<active : BOOLEAN;⓪<hdl : GemHandle;⓪:END;⓪ ⓪"BEGIN⓪$oldGem.active := GemActive ();⓪$IF oldGem.active THEN oldGem.hdl := CurrGemHandle() END;⓪$⓪$IF Length (wName) > maxNameLen THEN wName[maxNameLen] := 0C END;⓪$⓪$IF windowRoot = noWindPtr THEN⓪&success := connectToGem ();⓪&IF ~ success THEN RETURN END;⓪$END;⓪$SetCurrGemHandle (gemHdl, success);⓪$⓪$SysAlloc (hdl, SIZE (hdl^));⓪$IF (hdl = NIL) OR ~ success THEN⓪&IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪&success := FALSE;⓪&IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪&RETURN⓪$END;⓪$SysAlloc (hdl^.redrawStr, newColumns + 1);⓪$IF hdl^.redrawStr = NIL THEN⓪&IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪&success := FALSE;⓪&IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪&DEALLOCATE (hdl, SIZE (hdl^));⓪&RETURN⓪$END;⓪$⓪$AESWindows.UpdateWindow (TRUE);⓪$setFont (StdFontHdl, StdFontHeight);⓪$getCharSizes (hdl);⓪$AESWindows.UpdateWindow (FALSE);⓪$WITH hdl^ DO⓪&fontHdl:= StdFontHdl;⓪&ctrlMode := interpretCtrl;⓪&echoMode := restrictedEcho;⓪&wrapAround := TRUE;⓪&initEscAutomat (escStatus);⓪&initEscAutomat (pipeEscStatus);⓪&closed := FALSE;⓪&bgCol := white;⓪&fgCol := black;⓪&revMode := FALSE;⓪&cursX := 0;⓪&cursY := 0;⓪&cursIndex := 0;⓪&noCursHides := 1; (* Noch ist er aus *)⓪&textOrg := 0;⓪&columns := newColumns;⓪&rows := newRows;⓪&force := newForce;⓪&quality := qualities;⓪&enhanced := FALSE;⓪ ⓪&createPipe (writePipe, success);⓪&IF ~ success THEN⓪(DEALLOCATE( hdl^.redrawStr, 0L); (* !MS *)⓪(DEALLOCATE (hdl, 0L);⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪(RETURN⓪&END;⓪ ⓪&redrawArea.w := 0;⓪ ⓪&a := LONG (rows) * LONG (columns);⓪&IF a <= LONG (bufMax) THEN⓪(SysAlloc (buffer, a * TSIZE (bufferElem))⓪&END;⓪&IF (a > LONG (bufMax)) OR (buffer = NIL) THEN⓪(deletePipe (writePipe);⓪(DEALLOCATE( hdl^.redrawStr, 0L); (* !MS *)⓪(DEALLOCATE (hdl, 0L);⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪(success := FALSE;⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪(RETURN⓪&END;⓪&⓪&elems := WindowBase.WdwElemSet {};⓪&IF titled IN qualities THEN INCL (elems, WindowBase.titleElem) END;⓪&IF movable IN qualities THEN INCL (elems, WindowBase.moveElem) END;⓪&IF dynamic IN qualities THEN⓪(elems := elems + WindowBase.WdwElemSet {WindowBase.sizeElem,⓪PWindowBase.scrollElem}⓪&END;⓪&IF closable IN qualities THEN INCL (elems, WindowBase.closeElem) END;⓪&WindowBase.SysCreateWindow (handle, elems,⓪Bupdate, checkSpec, scrollAmt, activated, close,⓪Bhdl);⓪&⓪&IF WindowBase.WindowState (handle) # WindowBase.okWdw THEN⓪(WindowBase.ResetWindowState (handle);⓪(DEALLOCATE (buffer, 0L);⓪(deletePipe (writePipe);⓪(DEALLOCATE (hdl^.redrawStr, 0L); (* !MS *)⓪(DEALLOCATE (hdl, 0L);⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪(success := FALSE;⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪(RETURN⓪&END;⓪&WindowBase.GetWindowSpec (handle, spec);⓪&spec.virtual.w := LONGINT (LONG (columns)) * LONG (charW);⓪&spec.virtual.h := LONGINT (LONG (rows)) * LONG (charH);⓪&WindowBase.SetWindowSpec (handle, spec);⓪&setPosAndSize (hdl, colOrg, rowOrg, wOrg, hOrg);⓪&⓪&IF titled IN quality THEN⓪(WindowBase.SetWindowString (handle, WindowBase.titleWdwStr, wName)⓪&END;⓪&⓪&next := windowRoot; (* Einketten *)⓪&windowRoot := hdl;⓪&magic := windowMagic;⓪&level := modLevel;⓪&clearScreen (hdl);⓪&IF noHideWdw = mode THEN⓪(myShow (hdl);⓪(success := WindowBase.WindowState (handle) = WindowBase.okWdw;⓪(WindowBase.ResetWindowState (handle);⓪(IF NOT success THEN Close (hdl) END;⓪&END; (* 'Show' macht 'FlushEvents' *)⓪&(* Muß hier noch ein evtl. gesetzter Enhanced-Status abgemeldet werden⓪'* oder sendet das GEM einen 'NewTop'-Event, bei dem dies erledigt wird?⓪'*)⓪$⓪$END;(*WITH*)⓪$⓪$IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪"END Open;⓪ ⓪ PROCEDURE SysOpen (VAR hdl : Window; columns, rows: CARDINAL;⓪7qualitys : WQualitySet;mode : ShowMode;⓪7force : ForceMode; wName : ARRAY OF CHAR;⓪7colOrg, rowOrg: INTEGER; wOrg, hOrg : INTEGER;⓪3VAR success : BOOLEAN);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -32(A3),-(A7)⓪(MOVE.L -4(A3),-(A7)⓪(JSR Open⓪(MOVE.L (A7)+,A0⓪(MOVE.L (A7)+,A1⓪(TST (A0)⓪(BEQ ende⓪(CLR.W Window.level(A1)⓪&ende:⓪$END⓪"END SysOpen;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE ReSpecify ( hdl : Window;⓪9newColumns,⓪9newRows : CARDINAL;⓪9wName : ARRAY OF CHAR;⓪5VAR success : BOOLEAN);⓪"(*⓪#* TT: Wenn newColumns = 0, wird in "wName" ein Fontname und in "newRows"⓪#* die gewünschte Größe in "Pts" erwartet. Ist "hdl" NIL, wird⓪#* der Standard-Font damit definiert, sonst der für das Fenster.⓪#* Der Standard-Font wird bei allen neu erzeugten Fenstern verwendet.⓪#*)⓪ ⓪"VAR a : LONGCARD;⓪*newAddr : ADDRESS;⓪*sizeChg : BOOLEAN; (* Wurde Größe des Buffers verändert? *)⓪*spec : WindowBase.WindowSpec;⓪*fontname: ARRAY [0..64] OF CHAR;⓪*fontnr : CARDINAL;⓪*w, h, c : CARDINAL;⓪*ch : CHAR;⓪*aespb : GEMBase.AESPB;⓪*vdipb : GEMBase.VDIPB;⓪*newFont : BOOLEAN;⓪*oldGem : RECORD active: BOOLEAN; hdl: GemHandle; END;⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) & ((hdl#NIL) OR (newColumns#0)) THEN RETURN END;⓪$⓪$newFont:= FALSE;⓪$IF newColumns = 0 THEN⓪&(*⓪'* Font setzen⓪'*)⓪&IF hdl = NIL THEN⓪(oldGem.active := GemActive ();⓪(IF oldGem.active THEN oldGem.hdl := CurrGemHandle() END;⓪(IF windowRoot = noWindPtr THEN⓪*success := connectToGem ();⓪*IF ~success THEN RETURN END;⓪(END;⓪(SetCurrGemHandle (gemHdl, success);⓪&END;⓪&GEMBase.GetPBs (gemHdl, vdipb, aespb); (* für "GetFaceName" *)⓪&success:= FALSE;⓪&FOR fontnr:= 1 TO Fonts DO⓪(GetFaceName (device, fontnr, fontname);⓪(IF StrEqual (fontname, wName) THEN⓪*success:= TRUE;⓪*IF hdl = NIL THEN⓪,StdFontHdl:= vdipb.iooff^[0];⓪,SetTextFace (device, StdFontHdl);⓪,SetPtsTHeight (device, newRows, c, c, c, c); (* Größe setzen *)⓪,getCharSize (w, h, StdFontHeight, ch, ch);⓪,IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪,IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪,RETURN⓪*ELSE⓪,WITH hdl^ DO⓪.IF fontHdl # ORD (vdipb.iooff^[0]) THEN⓪0fontHdl:= vdipb.iooff^[0];⓪0newFont:= TRUE⓪.END;⓪.IF fontSize # newRows THEN⓪0fontSize:= newRows;⓪0newFont:= TRUE⓪.END⓪,END⓪*END⓪(END;⓪&END;⓪&IF ~newFont THEN⓪(IF hdl = NIL THEN⓪*IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪*IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;⓪(END;⓪(RETURN⓪&END;⓪$END;⓪ ⓪$IF Length (wName) > maxNameLen THEN wName[maxNameLen] := 0C END;⓪ ⓪$WITH hdl^ DO⓪&sizeChg := (newColumns # columns) OR (newRows # rows);⓪&IF sizeChg THEN⓪(IF newFont THEN⓪*SetTextFace (device, fontHdl);⓪*SetPtsTHeight (device, newRows, c, c, c, c); (* Größe setzen *)⓪*getCharSizes (hdl);⓪(ELSE⓪*a := LONG (newRows) * LONG (newColumns);⓪*IF a <= LONG (bufMax) THEN SysAlloc (newAddr,a * TSIZE (bufferElem)) END;⓪*IF (a > LONG (bufMax)) OR (newAddr = NIL) THEN⓪,success := FALSE;⓪,RETURN⓪*END;⓪*DEALLOCATE (buffer, 0L);⓪*columns := newColumns;⓪*rows := newRows;⓪*buffer := newAddr;⓪*textOrg := 0;⓪*cursIndex := 0;⓪(END;⓪(⓪(WindowBase.GetWindowSpec (handle, spec);⓪(spec.virtual.w := LONGINT (LONG (columns)) * LONG (charW);⓪(spec.virtual.h := LONGINT (LONG (rows)) * LONG (charH);⓪(WindowBase.SetWindowSpec (handle, spec);⓪ ⓪(IF newFont THEN⓪*WindowBase.RedrawWindow (handle);⓪(ELSE⓪*clearScreen (hdl);⓪(END;⓪(FlushEvents; (* Mögl. zu redraw geben *)⓪&END;⓪&⓪&IF ~newFont & (titled IN quality) THEN⓪(WindowBase.SetWindowString (handle, WindowBase.titleWdwStr, wName)⓪&END;⓪&⓪$END;(*WITH*)⓪$success:= TRUE⓪"END ReSpecify;⓪ ⓪ PROCEDURE Close (VAR hdl: Window);⓪ ⓪"PROCEDURE delete (VAR ptr: ptrWindow; toDelete: ptrWindow);⓪ ⓪$BEGIN⓪&IF ptr = NIL THEN HALT END; (* Dürfte nie vorkommen!! *)⓪&IF ptr = toDelete THEN⓪(ptr := toDelete^.next;⓪(DEALLOCATE (toDelete, 0L);⓪&ELSE delete (ptr^.next, toDelete) END;⓪$END delete;⓪ ⓪"BEGIN⓪$IF notValid (hdl, FALSE) THEN RETURN END;⓪$⓪$WITH hdl^ DO⓪ (*⓪&IF NOT isHidden (hdl) THEN⓪((* evtl. 'ShrinkBox' *)⓪(WindowBase.CloseWindow (handle)⓪&END;⓪!*)⓪&WindowBase.DeleteWindow (handle);⓪&DEALLOCATE (buffer, 0L);⓪&DEALLOCATE (redrawStr, columns + 1);⓪&deletePipe (hdl^.writePipe);⓪&magic := 0L;⓪$END;⓪$⓪$delete (windowRoot, hdl);⓪$hdl := NIL; (* Ist wohl unnötig, da es DEALLOCATE macht. *)⓪"⓪$FlushEvents;⓪$⓪$IF windowRoot = noWindPtr THEN deConnectFromGem END;⓪"END Close;⓪ ⓪ PROCEDURE Hide (hdl: Window);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$IF ~ isHidden (hdl) THEN⓪$⓪&WindowBase.CloseWindow (hdl^.handle);⓪&WindowBase.ResetWindowState (hdl^.handle);⓪&FlushEvents;⓪&⓪$END;⓪"END Hide;⓪ ⓪ PROCEDURE Show (hdl: Window);⓪ ⓪"BEGIN⓪$myShow (hdl);⓪$WindowBase.ResetWindowState (hdl^.handle);⓪"END Show;⓪ ⓪ PROCEDURE GetPosAndSize (hdl: Window; VAR col, row, w, h: INTEGER);⓪ ⓪"VAR frame: Rectangle;⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN col := 0; row := 0 ; w := 0; h := 0; RETURN END;⓪$WITH hdl^ DO⓪&frame:= WindowBase.WindowWorkArea (handle);⓪&col:= (frame.x+INT(stdCharW) DIV 2) DIV INT(stdCharW);⓪&row:= (frame.y+INT(stdCharH) DIV 2) DIV INT(stdCharH);⓪&w:= (frame.w) DIV charW; h:= (frame.h) DIV charH;⓪$END⓪"END GetPosAndSize;⓪ ⓪ PROCEDURE SetPosAndSize (hdl: Window; col, row, w, h: INTEGER);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$⓪$setPosAndSize (hdl, col, row, w, h);⓪"END SetPosAndSize;⓪ ⓪ PROCEDURE IsTop (hdl: Window): BOOLEAN;⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN FALSE END;⓪$⓪$RETURN isTop (hdl)⓪"END IsTop;⓪ ⓪ PROCEDURE PutOnTop (hdl: Window);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$⓪$WindowBase.PutWindowOnTop (hdl^.handle);⓪"END PutOnTop;⓪"⓪ PROCEDURE WasClosed (hdl: Window): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -4(A3),-(A7)⓪(MOVE.W #TRUE,(A3)+⓪(JSR isValid⓪(TST.W -(A3)⓪(BNE valid⓪(ADDQ.L #4,A7⓪(MOVE.W #FALSE,(A3)+⓪(BRA ende⓪ valid⓪(⓪(MOVE.L (A7)+,A0⓪(MOVE.W window.closed(A0),(A3)+⓪(MOVE.W #FALSE,window.closed(A0)⓪ ende⓪$END;⓪"END WasClosed;⓪"(*$L=*)⓪ ⓪ ⓪ VAR spot : Point;⓪(validBut : BOOLEAN;⓪(⓪ PROCEDURE butCatcher (clicks : CARDINAL;⓪6loc : Point;⓪6buts : MButtonSet;⓪6specials: SpecialKeySet): BOOLEAN;⓪ ⓪"BEGIN⓪$spot := loc;⓪$validBut := TRUE;⓪$⓪$RETURN FALSE;⓪"END butCatcher;⓪ ⓪ PROCEDURE DetectChar (REF targets: ARRAY OF Window; noTrg: CARDINAL;⓪:mode : DetectMode;⓪6VAR p : Point;⓪6VAR hdl: Window; VAR column,row : CARDINAL;⓪6VAR box: Rectangle; VAR result : DetectResult);⓪4⓪"VAR oldGem : GemHandle;⓪(success,⓪(doInit : BOOLEAN;⓪(i : CARDINAL;⓪(wdw : WindowBase.Window;⓪(wbRes : WindowBase.DetectWdwResult;⓪(⓪(proc : EventProc;⓪:⓪"BEGIN⓪$(* Init. exit val.s, for possible RETURN.⓪%*)⓪$result := foundNothing;⓪$hdl := noWindPtr;⓪$IF mode = requestPnt THEN p := Pnt (0, 0) END;⓪$⓪$(* Test target validity.⓪%*)⓪$IF (noTrg = 0) OR (noTrg > (HIGH (targets) + 1)) THEN noTrg := HIGH (targets)⓪$ELSE DEC (noTrg) END;⓪$FOR i := 0 TO noTrg DO IF ~ isMagicOrNIL (targets[i]) THEN RETURN END END;⓪$⓪$(* Init. GEM or set 'TW's gem handle.⓪%*)⓪$doInit := (windowRoot = noWindPtr);⓪$IF doInit THEN IF ~ connectToGem () THEN RETURN END;⓪$ELSE saveCurrHdl (oldGem) END;⓪$⓪$(* get pos. if required.⓪%*)⓪$IF mode = requestPnt THEN⓪&proc.event := mouseButton;⓪&proc.butHdler := butCatcher;⓪&REPEAT⓪(HandleEvents(1, MButtonSet{msBut1}, MButtonSet{msBut1},⓪5lookForEntry, Rect(0,0,0,0), lookForEntry, Rect(0,0,0,0),⓪50L,⓪5proc, 0);⓪&UNTIL validBut;⓪&p := spot;⓪$END;⓪ ⓪$i := 0;⓪$LOOP⓪$⓪&WindowBase.DetectWindow (targets[i]^.handle, 0, p, wdw, wbRes);⓪&⓪&IF wbRes = WindowBase.foundWdwDWR THEN⓪&⓪(result := foundWindow;⓪(hdl := targets[i];⓪(pointToCharPos (hdl, p, column, row, success);⓪(IF success THEN⓪*box := TransRect (Rect (0, 0, hdl^.charW, hdl^.charH),⓪<charToPointPos (hdl, column, row) );⓪*result := foundChar;⓪(END;⓪(⓪(EXIT⓪(⓪&ELSIF wbRes = WindowBase.unkownWdwDWR THEN result := foundWindow END;⓪&⓪&IF i >= noTrg THEN EXIT ELSE INC (i) END;⓪&⓪$END;⓪$⓪$IF doInit THEN deConnectFromGem ELSE restoreCurrHdl (oldGem) END;⓪"END DetectChar;⓪"⓪ ⓪ (* write proc.s (only writing to the pipe) *)⓪ ⓪ PROCEDURE Write (hdl: Window; ch: CHAR);⓪ ⓪"VAR oldGem: GemHandle;⓪"⓪"BEGIN⓪$IF notValid (hdl, TRUE) OR (ch = 0C) THEN RETURN END;⓪$saveCurrHdl (oldGem);⓪$⓪$insertIntoWritePipe (hdl, ch);⓪$⓪$restoreCurrHdl (oldGem);⓪"END Write;⓪ ⓪ PROCEDURE WriteString (hdl: Window; REF str: ARRAY OF CHAR);⓪ ⓪"VAR oldGem: GemHandle;⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$saveCurrHdl (oldGem);⓪$⓪$insertIntoWritePipe (hdl, str);⓪$⓪$restoreCurrHdl (oldGem);⓪"END WriteString;⓪ ⓪ PROCEDURE WriteLn (hdl: Window);⓪ ⓪"BEGIN⓪$WriteString (hdl, twoChars{cr, lf});⓪"END WriteLn;⓪ ⓪ PROCEDURE GotoXY (hdl: Window; column, row: CARDINAL);⓪ ⓪"BEGIN⓪$WriteString (hdl, fourChars{esc, 'Y', CHR (ORD (space) + row),⓪@CHR (ORD (space) + column)});⓪"END GotoXY;⓪ ⓪ PROCEDURE WritePg (hdl: Window);⓪"⓪"BEGIN⓪$WriteString (hdl, twoChars{esc, 'E'});⓪"END WritePg;⓪ ⓪ PROCEDURE SetCtrlMode (hdl: Window; mode: CtrlMode);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$hdl^.ctrlMode := mode;⓪"END SetCtrlMode;⓪ ⓪ PROCEDURE SetEchoMode (hdl: Window; mode: EchoMode);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$hdl^.echoMode := mode;⓪"END SetEchoMode;⓪ ⓪ PROCEDURE EnhancedOutput (hdl: Window; start: BOOLEAN);⓪ ⓪"VAR str: ARRAY[0..1] OF CHAR;⓪ ⓪"BEGIN⓪$str[0] := esc;⓪$IF start THEN str[1] := ctrlE ELSE str[1] := ctrlF END;⓪$WriteString (hdl, str);⓪"END EnhancedOutput;⓪ ⓪ PROCEDURE FlushPipe (hdl: Window);⓪ ⓪"BEGIN⓪$WriteString (hdl, twoChars{esc, ctrlP});⓪"END FlushPipe;⓪"⓪ ⓪ (* read proc.s (flushing the pipe, before action) *)⓪ ⓪ ⓪ VAR keyBuffer : GemChar;⓪(specialsBuffer : SpecialKeySet;⓪(keyBufferEmpty : BOOLEAN;⓪ ⓪ PROCEDURE keyProc (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3), A0⓪(MOVE.B (A0), specialsBuffer⓪(MOVE.L -(A3), A0⓪(MOVE.W (A0), keyBuffer⓪(MOVE.W #FALSE, (A3)+⓪(CLR keyBufferEmpty⓪$END;⓪"END keyProc;⓪"(*$L=*)⓪ ⓪ PROCEDURE timeProc (): BOOLEAN;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W #FALSE,(A3)+⓪$END;⓪"END timeProc;⓪"(*$L=*)⓪ ⓪ PROCEDURE read (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;⓪ ⓪"VAR procs: ARRAY[1..2] OF EventProc;⓪*gotit: BOOLEAN;⓪ ⓪"BEGIN⓪$IF keyBufferEmpty THEN⓪ ⓪&procs[1].event := keyboard;⓪&procs[1].keyHdler := keyProc;⓪&procs[2].event := timer;⓪&procs[2].timeHdler := timeProc;⓪&HandleEvents (0, MButtonSet{}, MButtonSet{},⓪4lookForEntry, Rect (0,0,0,0), lookForEntry, Rect (0,0,0,0),⓪40L,⓪4procs, 0);⓪4⓪$END;⓪$⓪$ch := keyBuffer;⓪$specials := specialsBuffer;⓪$gotit:= NOT keyBufferEmpty;⓪$keyBufferEmpty:= TRUE;⓪ ⓪$RETURN gotit⓪"END read;⓪ ⓪ PROCEDURE AbortRead (hdl: Window);⓪"BEGIN⓪$(*!!! muß noch impl. werden!!!*)⓪$(* dabei beachten, daß window auch geschlossen sein darf - dann⓪%* keinen fehler melden!⓪%*)⓪"END AbortRead;⓪"⓪ ⓪ PROCEDURE Read (hdl: Window; VAR ch: CHAR);⓪"⓪"VAR wait : BOOLEAN;⓪(gCh : GemChar;⓪(voidSp : SpecialKeySet;⓪(noHides: CARDINAL;⓪(oldGem : GemHandle;⓪"⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$saveCurrHdl (oldGem);⓪$⓪$WITH hdl^ DO⓪&wait := NOT read (gCh, voidSp);⓪&IF wait THEN (* Evtl. Cursor an und auf Zeichen warten *)⓪(noHides := noCursHides;⓪(IF echoMode = noEcho THEN⓪*noHides := 0⓪(ELSE⓪*noCursHides := 1;⓪*internalCursorOn (hdl); (* does also a flush *)⓪(END;⓪(REPEAT UNTIL read (gCh, voidSp);⓪(IF noHides # 0 THEN⓪*internalCursorOff (hdl); (* does also a flush *)⓪*noCursHides := noHides;⓪(END;⓪&END;⓪&ch := gCh.ascii;⓪&CASE echoMode OF⓪(noEcho : |⓪(restrictedEcho : IF ch >= ' ' THEN Write (hdl, ch) END|⓪(fullEcho : Write (hdl, ch)|⓪&END;⓪&IF wait THEN internalFlushPipe (hdl) END;⓪$END;⓪$restoreCurrHdl (oldGem);⓪"END Read;⓪ ⓪ PROCEDURE Done (hdl: Window): BOOLEAN;⓪ ⓪"BEGIN⓪$RETURN hdl^.done⓪"END Done;⓪ ⓪ PROCEDURE moveX (no: INTEGER);⓪ ⓪"BEGIN⓪$flushWritePipe (globHdl);⓪$setCursor (globHdl, INTEGER (globHdl^.cursX) + no, globHdl^.cursY)⓪"END moveX;⓪ ⓪ PROCEDURE myWrite (c: CHAR);⓪ ⓪"BEGIN⓪$insertIntoWritePipe (globHdl, c);⓪"END myWrite;⓪ ⓪ VAR globLeadingBlanks: BOOLEAN;⓪ ⓪ PROCEDURE rdCmd (VAR c: StringEditor.Commands; VAR ch: CHAR);⓪"VAR k: Key; again, isSep: BOOLEAN;⓪"BEGIN⓪$internalFlushPipe (globHdl);⓪$again:= FALSE;⓪$REPEAT⓪&GetKey (k);⓪&ch:= k.ch;⓪&c:= StringEditor.StdCmd (k);⓪&IF globToken THEN⓪(isSep:= ch IN MOSConfig.Separators;⓪(IF globLeadingBlanks THEN⓪*IF isSep THEN⓪,IF ch >= ' ' THEN⓪.myWrite (ch)⓪,END;⓪,again:= TRUE;⓪*ELSE⓪,globLeadingBlanks:= FALSE⓪*END⓪(ELSIF isSep THEN⓪*IF ch >= ' ' THEN⓪,myWrite (ch)⓪*END;⓪*c:= StringEditor.enter⓪(END⓪&END⓪$UNTIL ~again;⓪$globHdl^.done:= (c # StringEditor.abort);⓪"END rdCmd;⓪ ⓪ PROCEDURE myWriteString (REF c: ARRAY OF CHAR);⓪"BEGIN⓪$insertIntoWritePipe (globHdl, c);⓪"END myWriteString;⓪ ⓪ PROCEDURE myEditLine( VAR dStr: ARRAY OF CHAR; mayCtrl, token: BOOLEAN);⓪"BEGIN⓪$globToken:= token;⓪$globLeadingBlanks:= TRUE;⓪$WriteString (globHdl, twoChars{esc, ctrlE}); (* enhanced output on *)⓪$StringEditor.Edit (dStr, mayCtrl, myWrite, myWriteString, moveX, rdCmd);⓪$WriteString (globHdl, twoChars{esc, ctrlF}); (* enhanced output off *)⓪"END myEditLine;⓪ ⓪ PROCEDURE EditLine (hdl: Window; VAR str: ARRAY OF CHAR);⓪ ⓪"VAR success : BOOLEAN;⓪(i : CARDINAL;⓪(ch : GemChar;⓪(oldEnh : BOOLEAN;⓪(oldEscStatus: escStatusDesc;⓪(oldGem : GemHandle;⓪"⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$saveCurrHdl (oldGem);⓪$⓪$WITH hdl^ DO⓪$⓪&internalFlushPipe (hdl);⓪&oldEnh := enhanced;⓪&oldEscStatus := escStatus;⓪&enhanced := FALSE;⓪&initEscAutomat (escStatus);⓪&internalCursorOn (hdl);⓪&⓪&globHdl:= hdl;⓪&myEditLine (str, ctrlMode = writeCtrl, FALSE);⓪"⓪&internalCursorOff (globHdl);⓪&escStatus := oldEscStatus;⓪&enhanced := oldEnh;⓪$⓪$END;⓪&⓪$restoreCurrHdl (oldGem);⓪"END EditLine;⓪ ⓪ PROCEDURE ReadLine (hdl: Window; VAR str: ARRAY OF CHAR);⓪ ⓪"BEGIN⓪$str[0]:= 0C;⓪$EditLine (hdl, str)⓪"END ReadLine;⓪ ⓪ PROCEDURE ReadString (hdl: Window; VAR str: ARRAY OF CHAR);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(JMP ReadLine⓪$END⓪"END ReadString;⓪"(*$L=*)⓪ ⓪ PROCEDURE ReadToken (hdl: Window; VAR str: ARRAY OF CHAR);⓪ ⓪"VAR success : BOOLEAN;⓪(i : CARDINAL;⓪(ch : GemChar;⓪(oldEnh : BOOLEAN;⓪(oldEscStatus: escStatusDesc;⓪(oldCtrlMode : CtrlMode;⓪(⓪(oldGem : GemHandle;⓪"⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$saveCurrHdl (oldGem);⓪$⓪$WITH hdl^ DO⓪$⓪&internalFlushPipe (hdl);⓪&oldCtrlMode := ctrlMode;⓪&oldEnh := enhanced;⓪&oldEscStatus := escStatus;⓪&ctrlMode := interpretCtrl;⓪&enhanced := FALSE;⓪&initEscAutomat (escStatus);⓪&internalCursorOn (hdl);⓪&⓪&globHdl:= hdl;⓪&myEditLine (str, FALSE, TRUE);⓪&⓪&internalCursorOff (globHdl);⓪&escStatus := oldEscStatus;⓪&enhanced := oldEnh;⓪&ctrlMode := oldCtrlMode;⓪$⓪$END;⓪$⓪$restoreCurrHdl (oldGem);⓪"END ReadToken;⓪ ⓪ PROCEDURE UndoRead;⓪"BEGIN⓪$keyBufferEmpty:= FALSE⓪"END UndoRead;⓪ ⓪ ⓪ PROCEDURE GetPos (hdl: Window; VAR column, row: CARDINAL);⓪"⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN row := 0; column := 0; RETURN END;⓪$⓪$column := hdl^.cursX; row := hdl^.cursY;⓪"END GetPos;⓪ ⓪ PROCEDURE GetCtrlMode (hdl: Window; VAR mode: CtrlMode);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN mode := interpretCtrl; RETURN END;⓪$mode := hdl^.ctrlMode;⓪"END GetCtrlMode;⓪ ⓪ PROCEDURE GetEchoMode (hdl: Window; VAR mode: EchoMode);⓪ ⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN mode := restrictedEcho; RETURN END;⓪$mode := hdl^.echoMode;⓪"END GetEchoMode;⓪"⓪ PROCEDURE ReadTextBuffer ( hdl : Window;⓪>col,⓪>row,⓪>amount : CARDINAL;⓪:VAR buffer : ARRAY OF CHAR;⓪:VAR nextCol, nextRow: CARDINAL);⓪ ⓪"VAR effects : effectSet;⓪(currElemPtr: ptrBufferElem;⓪(i, spaces,⓪(max : CARDINAL;⓪ ⓪"PROCEDURE insSpaces;⓪$⓪$BEGIN⓪&WHILE spaces > 0 DO⓪(buffer[i] := ' ';⓪(INC (i);⓪(DEC (spaces);⓪&END;⓪$END insSpaces;⓪$⓪"PROCEDURE ins (ch: CHAR);⓪"⓪$BEGIN⓪&insSpaces;⓪&buffer[i] := ch;⓪&INC (i);⓪&DEC (max);⓪$END ins;⓪$⓪"BEGIN⓪$IF notValid (hdl, TRUE) THEN RETURN END;⓪$⓪$internalFlushPipe (hdl);⓪$IF (amount = 0) OR (amount > HIGH (buffer)) THEN⓪&amount := HIGH (buffer)⓪$END;⓪$max := HIGH (buffer) + 1;⓪$⓪$spaces := 0;⓪$i := 0;⓪$effects := effectSet{}; (* !!! Stimmt das? Wohl nicht, aber wie besser? *)⓪$WHILE (row < hdl^.rows) AND (amount > 0) AND (max > 0) DO⓪&⓪&IF col = hdl^.columns THEN⓪(IF row + 1 < hdl^.rows THEN⓪*IF max < 2 THEN max := 0⓪*ELSE⓪,ins (cr);⓪,ins (lf);⓪,col := 0;⓪,INC (row);⓪*END;⓪(ELSE max := 0 END;⓪&END;⓪(⓪&currElemPtr := ADR (hdl^.buffer^[textBufferIndex (hdl, col, row)]);⓪&⓪&WHILE (col < hdl^.columns) AND (amount > 0) AND (max > 0) DO⓪(⓪(IF effects # currElemPtr^.effects THEN⓪(⓪*effects := currElemPtr^.effects;⓪*IF max < 3 THEN max := 0 ELSE⓪,ins (esc);⓪,IF inverse IN effects THEN ins ('p') ELSE ins ('q') END;⓪*END;⓪*⓪(END;⓪(⓪(IF max > 0 THEN⓪*IF currElemPtr^.ch = ' ' THEN INC (spaces); DEC (max);⓪*ELSE ins (currElemPtr^.ch) END;⓪(END;⓪(INC (currElemPtr, SIZE (currElemPtr^));⓪(INC (col);⓪(DEC (amount);⓪(⓪&END;⓪&⓪&IF (amount = 0) AND (col < hdl^.columns) THEN insSpaces⓪&ELSE⓪(INC (max, spaces);⓪(spaces := 0;⓪&END;⓪$⓪$END;⓪$⓪$IF i <= HIGH (buffer) THEN buffer[i] := 0C END;⓪$nextCol := col;⓪$nextRow := row;⓪"END ReadTextBuffer;⓪"⓪ ⓪ (* window independent proc.s *)⓪ ⓪ PROCEDURE KeyPressed (): BOOLEAN;⓪ ⓪ VAR ch : GemChar;⓪(gotone : BOOLEAN;⓪(voidSp : SpecialKeySet;⓪ ⓪"BEGIN⓪$gotone:= read (ch, voidSp); (* NICHT: 'valid:=read (keyBuffer)' wegen VAR-Parm. *)⓪$keyBufferEmpty:= NOT gotone;⓪$RETURN gotone⓪"END KeyPressed;⓪ ⓪ PROCEDURE CondRead (VAR ch: CHAR; VAR success: BOOLEAN);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(JSR read⓪(ADDQ.L #2,A7⓪(MOVE.W (A7)+,D1⓪(MOVE -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE D0,(A0)⓪(MOVE.L -(A3),A0⓪(BEQ c⓪(MOVE.B D1,(A0)⓪(RTS⓪&c CLR.B (A0)⓪$END⓪"END CondRead;⓪"(*$L=*)⓪ ⓪ PROCEDURE BusyRead (VAR ch:CHAR);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(JSR CondRead⓪(ADDQ.L #2,A7⓪$END⓪"END BusyRead;⓪"(*$L=*)⓪ ⓪ PROCEDURE FlushKbd;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪&c JSR KeyPressed⓪(TST -(A3)⓪(BEQ ende⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(SUBQ.L #2,A7⓪(MOVE.L A7,(A3)+⓪(JSR read⓪(ADDQ.L #4,A7⓪(SUBQ.L #2,A3⓪(BRA c⓪&ende⓪$END⓪"END FlushKbd;⓪"(*$L=*)⓪"⓪ PROCEDURE GetChar (VAR ch: CHAR);⓪"VAR gCh : GemChar;⓪(voidSp: SpecialKeySet;⓪"BEGIN⓪$REPEAT UNTIL read (gCh, voidSp);⓪$ch:= gCh.ascii;⓪"END GetChar;⓪ ⓪ PROCEDURE GetKey (VAR k: Key);⓪"VAR gCh: GemChar;⓪(sks: SpecialKeySet;⓪"BEGIN⓪$REPEAT UNTIL read (gCh, sks);⓪$ASSEMBLER⓪(MOVE.L k(A6),A0⓪(MOVE.W gCh(A6),D1 ; |scan| asc|⓪(MOVE.B sks(A6),D0⓪(LSR.B #1,D0⓪(BCC n⓪(BSET #0,D0⓪%n: ANDI.B #1111%,D0⓪(SWAP D1⓪(CLR D1⓪(ROL.L #8,D1⓪(MOVE.L D1,(A0) ; | asc| 0| 0|scan|⓪(MOVE.B D0,1(A0)⓪$END⓪"END GetKey;⓪ ⓪ PROCEDURE GetGemChar (VAR ch: GemChar; VAR specials: SpecialKeySet);⓪"BEGIN⓪$REPEAT UNTIL read (ch, specials);⓪"END GetGemChar;⓪ ⓪ ⓪8(* misc. managment *)⓪8(* =============== *)⓪ ⓪ PROCEDURE levelCounter (start, child: BOOLEAN; VAR id: INTEGER);⓪ ⓪"VAR ptr : ptrWindow;⓪*again : BOOLEAN;⓪"⓪"BEGIN⓪$IF child THEN⓪$⓪&IF start THEN⓪(INC (modLevel)⓪&ELSE⓪&⓪(REPEAT⓪*again := FALSE;⓪*ptr := windowRoot;⓪*LOOP⓪*⓪,IF ptr = NIL THEN EXIT END;⓪,IF ptr^.level >= modLevel THEN⓪.Close (ptr);⓪.again := TRUE;⓪.EXIT;⓪,END;⓪,ptr := ptr^.next;⓪,⓪*END;(*LOOP*)⓪(UNTIL ~ again;⓪(⓪(DEC (modLevel);⓪(⓪&END;(*IF start ELSE*)⓪&⓪$END;⓪"END levelCounter;⓪ ⓪ PROCEDURE termProc;⓪ ⓪"BEGIN⓪ (*$? TestVersion:⓪"Terminal.WriteString ("'TextWindows' terminating."); Terminal.WriteLn;⓪!*)⓪$(* Zum Zeitpunkt des Aufrufs dieser Proc, ist modLevel=0 *)⓪$levelCounter (FALSE,TRUE, voidI);(* Alle Elem. bis incl. modLevel=0 abmelden *)⓪"END termProc;⓪ ⓪ PROCEDURE removalProc;⓪ ⓪"BEGIN⓪ (*$? TestVersion:⓪"Terminal.WriteString ("'TextWindows' removing."); Terminal.WriteLn;⓪!*)⓪$(* Zum Zeitpunkt des Aufrufs dieser Proc, ist modLevel=0 *)⓪$levelCounter (FALSE,TRUE, voidI);(* Alle Elem. bis incl. modLevel=0 abmelden *)⓪"END removalProc;⓪ ⓪ ⓪ VAR envlpProcHdl : EnvlpCarrier;⓪(termProcHdl : TermCarrier;⓪(removalProcHdl : RemovalCarrier;⓪(wsp : MemArea;⓪(⓪(ok : BOOLEAN;⓪(⓪ BEGIN⓪"windowRoot := noWindPtr;⓪"modLevel := 1;⓪"⓪"stdMFDB.start := NIL;⓪"⓪"keyBufferEmpty:= TRUE;⓪ ⓪"eventHandling := FALSE;⓪"⓪"installTimeProc (FlushEvents, 500); (* Alle 1/2 sec. 'FlushEvents' *)⓪"⓪"SetEnvelope (envlpProcHdl, levelCounter, wsp);⓪"CatchProcessTerm (termProcHdl, termProc, wsp);⓪"CatchRemoval (removalProcHdl, removalProc, wsp);⓪ END TextWindows.⓪ ə
- (* $FFEC5D1D$FFEBA329$0000871F$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFED5D35$FFF749DC$00000031$FFF749DC$00012F02$FFF749DC$0000C62F$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFE9E66C$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$00005522$FFF749DC$FFF749DC$0000DC62$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFEC5D1D$FFF749DC$FFF749DCÇ$00007D20........T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001C7B$00001C97$00007D67$00007D20$FFDF398E$00007BE8$FFDF398E$00007DC2$00007D20$00001CA9$00001BD9$FFDF398E$FFDF398E$00001CA9$00001C83$00001CA6ÉÇâ*)
-
